VBA-發貨單自動化報表

05-18

VBA-發貨單自動化報表

來自專欄數據分析項目(python/Excel)

項目：發貨單自動化報表

目的：利用VBA減輕船務的工作，提高工作效率

需求：根據FE中的發票號自動生成對應發貨單（發票），並計算匯總，翻譯等功能

備註：由於數據保密性，已替換BD原數據

由於船務需要製作各種單證,並且重複性操作比較多，所以利用學到的Excel技巧來實現自動化替代人為操作。

思路

準備數據
Basic Data複製到<Auto>中
根據發票號對Basic Data 進行分類
對匯總金額進行英文翻譯

準備數據

BasicData.xlsx:需要分類的基礎數據

autoINV.xlsm:發貨單Demo的文件,最終發貨單會生成在此文件

製作autoINV及發貨單Demo

Basic Data複製到<Auto>中

基礎表有2個或2個以上

根據發票號對Basic Data 進行分類

根據BD1的發票號(K列)生成3個sheet

分別將BD1,BD2的數據填充進對應發貨單

對匯總金額進行英文翻譯

結束,提示<已完成>

總結

項目遇到問題

多次修改報表邏輯以及設計
對數組的使用
修改代碼

解決方案

問題1：多次修改報表邏輯以及設計

詳細了解客戶的需求

開發前，了解工作流程，業務邏輯
開發中，邊開發邊溝通
開發後，測試-上線-維護

從客戶審美出發，優化報表外觀設計

調整報表字體，配色

問題2：對數組的使用

去ExcelHome論壇，Google學習別人的代碼
數組可以大大提高代碼運行的效率

問題3：修改代碼

不斷的debug，修正邏輯
熟悉代碼
學習數組

代碼如下：

Sub auto_INV()

關閉彈窗

Application.DisplayAlerts = False

Application.AskToUpdateLinks = False

Application.ScreenUpdating = False

修改默認打開路勁

D = Mid(ThisWorkbook.Path, 1, 1) 獲取本系統驅動器盤位置

L = ThisWorkbook.Path 定義本工作簿的路經

ChDrive D

ChDir L

記錄分表名字

Dim myWBName As String

myWBName = ThisWorkbook.Name

mySh1Name = Workbooks(myWBName).Sheets(1).Name

打開發票匯總表

Dim fileToOpenBD, fileToOpenINV, BD_WBName, INV_WBName

打開基礎數據表

MsgBox ("請打開<基礎數據表>")

fileToOpenBD = Application.GetOpenFilename()

Workbooks.Open (fileToOpenBD)

BD_WBName = ActiveWorkbook.Name

選擇N個表

Dim ii%, arr()

For ii = 1 To Sheets.Count

ReDim Preserve arr(0 To ii - 1)

arr(ii - 1) = Worksheets(ii).Name

Worksheets(arr).Select

移動N個表到myWBName

Worksheets(arr).Copy after:=Workbooks(myWBName).Sheets(mySh1Name)

關閉文件

Workbooks(BD_WBName).Close False

複製提單TD到wbName

ActiveWorkbook.Sheets("匯總").Columns("A:A").Select

Range(Selection, Selection.End(xlToRight)).Select

Application.CutCopyMode = False

Selection.Copy

Windows(myWBName).Activate

Sheets("OOCL匯總").Select

Range("a1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

打開分櫃TD

MsgBox ("請打開<提單信息>")

fileToOpenTD = Application.GetOpenFilename()

Workbooks.Open (fileToOpenTD)

wbTDName = ActiveWorkbook.Name

複製分櫃FG到wbName

Dim shCount As Integer, i As Integer

sheeti = Workbooks(myWBName).Sheets.Count

shCount = ActiveWorkbook.Sheets.Count

For i = 1 To shCount

Workbooks(wbTDName).Sheets(i).Copy after:=Workbooks(myWBName).Sheets(sheeti)

sheeti = sheeti + 1

記錄表名

Dim mySh2Name, mySh3Name As String

mySh2Name = Workbooks(myWBName).Sheets(2).Name

mySh3Name = Workbooks(myWBName).Sheets(3).Name

返回FE表

Workbooks(myWBName).Sheets(mySh2Name).Select

批量生成sheet

Dim INVCOUNT As Integer, sht As Worksheet, lastrow As Integer

lastrow = Workbooks(myWBName).Sheets(mySh2Name).Range("A65536").End(xlUp).Row

For INVCOUNT = 2 To lastrow

Workbooks(myWBName).Sheets(mySh2Name).Select

If Sheets(mySh2Name).Cells(INVCOUNT, "K") <> Workbooks(myWBName).Sheets(Worksheets.Count).Name Then

If Sheets(mySh2Name).Cells(INVCOUNT, "K") <> "" Then

Worksheets(mySh1Name).Copy after:=Workbooks(myWBName).Sheets(Sheets.Count)

ActiveSheet.Name = Sheets(mySh2Name).Cells(INVCOUNT, "K").Value

End If

INVCOUNT = INVCOUNT + 1

整理髮貨單

Dim INV_endRow, INV_Row As Integer

For INVCOUNT = 2 To lastrow

If Sheets(mySh2Name).Cells(INVCOUNT, "K") <> "" Then

取得分類最後一行

INV_endRow = Worksheets(Cells(INVCOUNT, "K").Value).Cells(33, "B").End(xlUp).Row

INV_Row = INV_endRow + 1

Sheets(Cells(INVCOUNT, "K").Value).Cells(INV_Row, "B") = Sheets(mySh2Name).Cells(INVCOUNT, "D")

Sheets(Cells(INVCOUNT, "K").Value).Cells(INV_Row, "C") = Sheets(mySh2Name).Cells(INVCOUNT, "C")

Sheets(Cells(INVCOUNT, "K").Value).Cells(INV_Row, "D") = Sheets(mySh2Name).Cells(INVCOUNT, "E")

Sheets(Cells(INVCOUNT, "K").Value).Cells(INV_Row, "F") = Sheets(mySh2Name).Cells(INVCOUNT, "I")

Sheets(Cells(INVCOUNT, "K").Value).Cells(INV_Row, "G") = Sheets(mySh2Name).Cells(INVCOUNT, "J")

Sheets(Cells(INVCOUNT, "K").Value).Cells(INV_Row, "E") = Sheets(Cells(INVCOUNT, "K").Value).Cells(INV_Row, "F").Value / Sheets(Cells(INVCOUNT, "K").Value).Cells(INV_Row, "D").Value

Sheets(Cells(INVCOUNT, "K").Value).Cells(4, "G") = Sheets(mySh2Name).Cells(INVCOUNT, "K").Value

Sheets(Cells(INVCOUNT, "K").Value).Cells(8, "C") = Sheets(mySh3Name).Cells(1, "C")

Sheets(Cells(INVCOUNT, "K").Value).Cells(9, "C") = Sheets(mySh3Name).Cells(2, "C")

Sheets(Cells(INVCOUNT, "K").Value).Cells(5, "G") = Sheets(mySh3Name).Cells(3, "C")

Sheets(Cells(INVCOUNT, "K").Value).Cells(35, "C") = Sheets(mySh3Name).Cells(4, "C")

Sheets(Cells(INVCOUNT, "K").Value).Cells(34, "C") = "=" & "US DOLLAR " & "NumberToString(F32)"

Sheets(Cells(INVCOUNT, "K").Value).Cells(34, "C") = "US DOLLAR " & NumberToString(Sheets(Cells(INVCOUNT, "K").Value).Cells(32, "F"))

End If

定義最後一行

Dim endRow As Integer, j As Integer, myName As String

endRow = Workbooks(myWBName).Sheets("OOCL匯總").Range("A65536").End(xlUp).Row

For j = 2 To endRow

myName = Sheets("OOCL匯總").Range("A" & j)

Sheets(myName).Range("J31") = Sheets("OOCL匯總").Range("C" & j)

Sheets(myName).Range("J32") = Sheets("OOCL匯總").Range("D" & j)

Sheets(myName).Range("G30") = Sheets("OOCL匯總").Range("E" & j)

Sheets(myName).Range("P29") = Sheets("OOCL匯總").Range("F" & j)

Sheets(myName).Range("N29") = Sheets("OOCL匯總").Range("G" & j)

Sheets(myName).Range("G29") = Sheets("OOCL匯總").Range("I" & j)

Sheets("OOCL匯總").Range("N" & j) = "已更新"

打開彈窗

Application.DisplayAlerts = True

Application.AskToUpdateLinks = True

Application.ScreenUpdating = True

MsgBox "已完成填寫!!!請檢查!!!"

End Sub

NumToStr

Option Explicit

Dim StrNO(19) As String

Dim Unit(8) As String

Dim StrTens(9) As String

Public Function NumberToString(Number As Double) As String

Dim Str As String, BeforePoint As String, AfterPoint As String, tmpStr As String

Dim Point As Integer

Dim nBit As Integer

Dim CurString As String

Dim nNumLen As Integer

Dim T As String

Call Init

Str = CStr(Round(Number, 2))

Str = Number

If InStr(1, Str, ".") = 0 Then

BeforePoint = Str

AfterPoint = ""

Else

BeforePoint = Left(Str, InStr(1, Str, ".") - 1)

T = Right(Str, Len(Str) - InStr(1, Str, "."))

If Len(T) < 2 Then AfterPoint = Val(T) * 10

If Len(T) = 2 Then AfterPoint = Val(T)

If Len(T) > 2 Then AfterPoint = Val(Left(T, 2))

End If

If Len(BeforePoint) > 12 Then

NumberToString = "Too Big."

Exit Function

End If

Str = ""

Do While Len(BeforePoint) > 0

nNumLen = Len(BeforePoint)

If nNumLen Mod 3 = 0 Then

CurString = Left(BeforePoint, 3)

BeforePoint = Right(BeforePoint, nNumLen - 3)

Else

CurString = Left(BeforePoint, (nNumLen Mod 3))

BeforePoint = Right(BeforePoint, nNumLen - (nNumLen Mod 3))

End If

nBit = Len(BeforePoint) / 3

tmpStr = DecodeHundred(CurString)

If (BeforePoint = String(Len(BeforePoint), "0") Or nBit = 0) And Len(CurString) = 3 Then

If CInt(Left(CurString, 1)) <> 0 And CInt(Right(CurString, 2)) <> 0 Then

tmpStr = Left(tmpStr, InStr(1, tmpStr, Unit(4)) + Len(Unit(4))) & Unit(8) & " " & Right(tmpStr, Len(tmpStr) - (InStr(1, tmpStr, Unit(4)) + Len(Unit(4))))

Else If CInt(Left(CurString, 1)) <> 0 And CInt(Right(CurString, 2)) = 0 Then

tmpStr = Unit(8) & " " & tmpStr

End If

If nBit = 0 Then

Str = Trim(Str & " " & tmpStr)

Else

Str = Trim(Str & " " & tmpStr & " " & Unit(nBit))

End If

If Left(Str, 3) = Unit(8) Then Str = Trim(Right(Str, Len(Str) - 3))

If BeforePoint = String(Len(BeforePoint), "0") Then Exit Do

Debug.Print Str

Loop

BeforePoint = Str

If Len(AfterPoint) > 0 Then

AfterPoint = Unit(8) & " " & Unit(7) & " " & DecodeHundred(AfterPoint) & " " & Unit(5)

Else

AfterPoint = Unit(5)

End If

NumberToString = BeforePoint & " " & AfterPoint

End Function

Private Function DecodeHundred(HundredString As String) As String

Dim tmp As Integer

If Len(HundredString) > 0 And Len(HundredString) <= 3 Then

Select Case Len(HundredString)

Case 1

tmp = CInt(HundredString)

If tmp <> 0 Then DecodeHundred = StrNO(tmp)

Case 2

tmp = CInt(HundredString)

If tmp <> 0 Then

If (tmp < 20) Then

DecodeHundred = StrNO(tmp)

Else

If CInt(Right(HundredString, 1)) = 0 Then

DecodeHundred = StrTens(Int(tmp / 10))

Else

DecodeHundred = StrTens(Int(tmp / 10)) & "-" & StrNO(CInt(Right(HundredString, 1)))

End If

Case 3

If CInt(Left(HundredString, 1)) <> 0 Then

DecodeHundred = StrNO(CInt(Left(HundredString, 1))) & " " & Unit(4) & " " & DecodeHundred(Right(HundredString, 2))

Else

DecodeHundred = DecodeHundred(Right(HundredString, 2))

End If

Case Else

End Select

End If

End Function

Private Sub Init()

If StrNO(1) <> "One" Then

StrNO(1) = "One"

StrNO(2) = "Two"

StrNO(3) = "Three"

StrNO(4) = "Four"

StrNO(5) = "Five"

StrNO(6) = "Six"

StrNO(7) = "Seven"

StrNO(8) = "Eight"

StrNO(9) = "Nine"

StrNO(10) = "Ten"

StrNO(11) = "Eleven"

StrNO(12) = "Twelve"

StrNO(13) = "Thirteen"

StrNO(14) = "Fourteen"

StrNO(15) = "Fifteen"

StrNO(16) = "Sixteen"

StrNO(17) = "Seventeen"

StrNO(18) = "Eighteen"

StrNO(19) = "Nineteen"

StrTens(1) = "Ten"

StrTens(2) = "Twenty"

StrTens(3) = "Thirty"

StrTens(4) = "Forty"

StrTens(5) = "Fifty"

StrTens(6) = "Sixty"

StrTens(7) = "Seventy"

StrTens(8) = "Eighty"

StrTens(9) = "Ninety"

Unit(1) = "Thousand" 材熌

Unit(2) = "Million" 材熌

Unit(3) = "Billion" 材熌

Unit(4) = "Hundred"

Unit(5) = "Only"

Unit(6) = "Point"

Unit(7) = "Cents"

Unit(8) = "And"

End If

End Sub