使用VBA自动化处理Excel数据生成装箱单

在现代商业环境中，数据管理和文档处理是日常工作中不可或缺的一部分。尤其是对于那些需要频繁处理大量数据并生成定制化文档（如装箱单）的行业，如物流、制造业和零售业，自动化处理显得尤为重要。Excel作为一款功能强大的数据处理工具，结合VBA（Visual Basic for Applications）编程，能够极大地提升工作效率，减少人为错误。本文将详细介绍一个利用VBA编写的Excel宏，该宏能够自动化处理发票数据，生成装箱单，并设置打印选项，确保数据的准确性和文档的快速生成。

首先，我们将通过一个名为Sub DivideNumbersAndWriteToSheet2()的VBA过程来展示如何读取发票数据（如“CUSTOMS INVOICE”工作表中的数据），并根据特定规则（如每500单位一个装箱，小于500订单数，按实际数量一个装箱）将数据拆分到另一个工作表（“PACKING LIST”）中。在这个过程中，不仅会根据数量自动插入相应数量的行，还会根据需要从另一工作表（“型号”）中查找匹配项并计算乘积，最后汇总装箱单中的各项数据。

接下来，Sub MultiplyValues()过程展示了如何在一个工作表（如“PACKING LIST”）中查找并计算特定列的值，并将计算结果写入相邻列中。这一过程对于需要根据商品单价和数量计算总价的情况非常有用。

为了保持装箱单的整洁和清晰，Sub DeleteRows()过程用于删除不必要的行，确保只有需要的数据被保留在装箱单中。

此外，本文还介绍了如何通过Sub D_打印()过程设置打印选项，如纸张大小和方向，以及如何通过Private Sub FindPrint()和Private Sub Printsetup()等子程序来管理打印机设置，确保文档能够准确无误地打印出来。

最后，Sub 调用打印机()过程展示了如何根据已设置的打印机名称自动打印文档，进一步简化了打印流程。

完整代码如下：

' Sub DivideNumbersAndWriteToSheet2: 将数字分割并写入到Sheet2
Sub DivideNumbersAndWriteToSheet2()
    Dim ws1 As Worksheet ' 定义工作表变量ws1
    Dim ws2 As Worksheet ' 定义工作表变量ws2
    Dim rng1 As Range ' 定义范围变量rng1
    Dim rng2 As Range ' 声明但未使用rng2
    Dim cell As Range ' 定义单元格变量cell
    Dim divideBy As Double ' 定义除数
    Dim rowNum As Integer ' 定义行数变量
    Dim i As Integer ' 循环变量
    Dim rowCounter As Integer ' 行计数器
    Dim r, lastRow, n As Long ' 定义长整型变量
    Dim insertRow As Integer ' 定义插入行的起始行号
    Dim cellHeight As Double ' 定义单元格行高

    ' 设置工作表
    Set ws1 = ThisWorkbook.Sheets("CUSTOMS INVOICE")
    Set ws2 = ThisWorkbook.Sheets("PACKING LIST")
    r = ws1.Range("合计").Row ' 获取"合计"的行号
    
    lastRow = ws1.Range("B" & r).End(xlUp).Row ' 获取B列最后一个非空单元格的行号

    ' 设置要读取的范围
    Set rng1 = ws1.Range("B14:C" & lastRow)
    insertRow = 11 ' 开始插入行的行号
    rowCounter = 1 ' 初始化行计数器

    ' 设置除数
    divideBy = 500

    ' 保存当前单元格行高
    cellHeight = ws1.Range("B14").RowHeight

    ' 循环读取并写入数据
    For Each cell In rng1
        If cell.Column = 3 Then ' 只处理C列的数据
            ' 计算需要插入的行数
            If cell.Value Mod divideBy = 0 And cell.Value < divideBy Then
                rowNum = divideBy
            Else
                rowNum = WorksheetFunction.RoundUp(cell.Value / divideBy, 0)
            End If

            ' 插入所需行数
            ws2.Rows(insertRow & ":" & insertRow + rowNum - 1).Insert Shift:=xlDown

            ' 设置新行的行高
            For i = insertRow To insertRow + rowNum - 1
                ws2.Rows(i).RowHeight = cellHeight
            Next i

            ' 填充数据
            For i = 1 To rowNum
                ws2.Cells(insertRow + i - 1, 1).Value = rowCounter
                ' 处理余数
                ws2.Cells(insertRow + i - 1, 3).Value = IIf(i = rowNum And cell.Value Mod divideBy <> 0, cell.Value Mod divideBy, divideBy)
                ws2.Cells(insertRow + i - 1, 2).Value = ws1.Cells(cell.Row, cell.Column - 1).Value
                ws2.Cells(insertRow + i - 1, 2).HorizontalAlignment = xlLeft
                ' 注释掉的行高和颜色设置
                ' ws2.Cells(insertRow + i - 1, 2).Interior.Color = cell.Interior.Color
                rowCounter = rowCounter + 1
            Next i

            insertRow = insertRow + rowNum
        End If
    Next cell
    
    ' 调用MultiplyValues子程序
    Call MultiplyValues
    n = ws2.Range("合计2").Row
    ' 计算并设置Sheet2的合计值
    ws2.Cells(n, "C").Value = Application.WorksheetFunction.Sum(ws2.Range("C11:C" & n - 1))
    ws2.Cells(n, "D").Value = Application.WorksheetFunction.Sum(ws2.Range("D11:D" & n - 1))
End Sub
Sub MultiplyValues()
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim cell As Range
    Dim lookupValue As Variant
    Dim multiplyValue As Double
    Dim r As Long
    ' 设置工作表
    Set ws2 = ThisWorkbook.Sheets("PACKING LIST")
    Set ws3 = ThisWorkbook.Sheets("型号")
    r = ws2.Range("合计2").Row
    
    
    ' 循环处理B14到B20
    For Each cell In ws2.Range("B11:B" & r - 1)
        lookupValue = cell.value
        
        ' 在Sheet3的B列中查找匹配值
        Dim foundCell As Range
        Set foundCell = ws3.Columns("A:A").Find(What:=lookupValue, LookIn:=xlValues, LookAt:=xlWhole)
        
        ' 如果找到匹配值，则将Sheet3中B列的值与Sheet2中C列的值相乘，结果写入Sheet2的D列
        If Not foundCell Is Nothing Then

     multiplyValue = foundCell.Offset(0, 1).value * ws2.Cells(cell.Row, "C").value
     ws2.Cells(cell.Row, "D").NumberFormat = "0.000000"
     ws2.Cells(cell.Row, "D").value = multiplyValue
        End If
    Next cell
    
End Sub

Sub DeleteRows()
    Dim i, n, r As Long
    n = Range("合计2").Row - 1
    
    For i = n To 11 Step -1
        If Not IsEmpty(Range("B" & i).value) Then
            Rows(i).EntireRow.Delete
        End If
    Next i
   r = Range("合计2").Row
    Range("C" & r).value = ""
     Range("D" & r).value = ""
    
End Sub

Sub D_打印()
        With ThisWorkbook.Sheets("PACKING LIST").PageSetup
            .PaperSize = xlPaperA4 '设置纸张大小为A4
            .Orientation = xlPortrait '设置纸张方向为纵向
        End With
        ThisWorkbook.Sheets("PACKING LIST").PrintPreview '打印预览
   
End Sub
Function NameExist(sName As String) As Boolean    '判断定义名称是否存在函数
Dim NameCount As Integer
NameExist = False
For NameCount = 1 To Workbooks(1).Names.Count
    If Workbooks(1).Names(NameCount).NameLocal = sName Then
        NameExist = True
        Exit Function
    End If
Next
End Function

Private Sub FindPrint()  '判断指定的打印机是否存在
      If Application.ActivePrinter = Evaluate(ActiveWorkbook.Names("printname").value) Then
     Exit Sub
     Else
          Call Printsetup    '调用打印机设置并定义名称
          Exit Sub
    End If
End Sub

Private Sub Printsetup()    '调用打印机设置并定义名称，把设定的打印机写入Excel名称
Dim n As Boolean, dyj$
    n = Application.Dialogs(xlDialogPrinterSetup).Show       '调用打印机设置
      If n = True Then
        dyj = Application.ActivePrinter
        ActiveWorkbook.Names.Add Name:="printname", RefersTo:=dyj   '写入名称
      Exit Sub
      End If
End Sub

Sub 调用打印机()      '打印
Dim n As Boolean, dyj$
If NameExist("printname") Then '判断是否有打印机名称定义存在，如没有调用打印机设置
Dim printyb, duankou, i%, j%
Call FindPrint  '判断指定的打印机是否存在
Sheet1.PrintOut Application.ActivePrinter = Evaluate(ActiveWorkbook.Names("printname").value)
Else
    Call Printsetup  '调用打印机设置
    Sheet1.PrintOut Application.ActivePrinter = Evaluate(ActiveWorkbook.Names("printname").value)   '打印Sheet1表格，可自行设定。
End If
End Sub

代码实现效果展示：

通过本文的详细解析，您将学习到如何使用VBA在Excel中实现复杂的数据处理和文档生成任务，从而提高工作效率，减少错误，并为日常的商业运营提供有力支持。