Excel宏实现发票数据规整：循环遍历行与格式转换需求

你的遍历思路完全可行，而且逻辑清晰，下面我会给出具体的VBA代码实现，同时提供一个更易维护的优化方案。

基础遍历实现（符合你的伪代码思路） #

这个代码严格按照你提出的循环遍历逻辑编写，逐行处理原始数据，收集每个发票的信息并写入新表：

Sub ConvertInvoiceData()
    Dim wsSource As Worksheet, wsDest As Worksheet
    Dim lastRow As Long, i As Long, destRow As Long
    Dim currentInvoice As String
    Dim planAInfo As String, planACost As String
    Dim planBInfo As String, planBCost As String
    Dim planCInfo As String, planCCost As String
    Dim totalAmount As String
    
    ' 可修改为指定的源工作表名称，比如Sheets("原始数据")
    Set wsSource = ActiveSheet
    ' 创建新工作表存放规整后的数据
    Set wsDest = ThisWorkbook.Sheets.Add(After:=wsSource)
    wsDest.Name = "规整发票数据"
    
    ' 写入目标表头
    With wsDest
        .Range("A1").Value = "Invoice No"
        .Range("B1").Value = "Plan AAAAA"
        .Range("C1").Value = "Plan AAAAA Cost"
        .Range("D1").Value = "Plan BBBBB"
        .Range("E1").Value = "Plan BBBBB Cost"
        .Range("F1").Value = "Plan CCCCC"
        .Range("G1").Value = "Plan CCCCC Cost"
        .Range("H1").Value = "Total"
        .Rows(1).Font.Bold = True ' 表头加粗
    End With
    destRow = 2 ' 从第二行开始写入数据
    
    ' 获取源数据最后一行行号
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历源数据每一行
    For i = 1 To lastRow
        Dim cellValue As String
        cellValue = Trim(wsSource.Cells(i, "A").Value)
        
        ' 识别发票起始行，重置当前发票的所有变量
        If InStr(1, cellValue, "INVOICE NO.", vbTextCompare) > 0 Then
            currentInvoice = Split(cellValue, " ")(2) ' 提取发票编号
            planAInfo = ""
            planACost = ""
            planBInfo = ""
            planBCost = ""
            planCInfo = ""
            planCCost = ""
            totalAmount = ""
        ' 识别发票总计行，写入数据到目标表
        ElseIf InStr(1, cellValue, "Total for", vbTextCompare) > 0 Then
            totalAmount = Split(cellValue, " ")(3) ' 提取总金额
            With wsDest
                .Cells(destRow, "A").Value = currentInvoice
                .Cells(destRow, "B").Value = planAInfo
                .Cells(destRow, "C").Value = planACost
                .Cells(destRow, "D").Value = planBInfo
                .Cells(destRow, "E").Value = planBCost
                .Cells(destRow, "F").Value = planCInfo
                .Cells(destRow, "G").Value = planCCost
                .Cells(destRow, "H").Value = totalAmount
            End With
            destRow = destRow + 1 ' 目标行下移
        ' 识别Plan行，拆分内容存入对应变量
        ElseIf InStr(1, cellValue, "Plan ", vbTextCompare) > 0 Then
            Dim planParts As Variant
            planParts = Split(cellValue, " ")
            ' 确保数据格式有效，避免拆分后数组长度不足
            If UBound(planParts) >= 3 Then
                Select Case planParts(1)
                    Case "AAAAA"
                        planAInfo = planParts(0) & " " & planParts(1) & " " & planParts(2)
                        planACost = planParts(3)
                    Case "BBBBB"
                        planBInfo = planParts(0) & " " & planParts(1) & " " & planParts(2)
                        planBCost = planParts(3)
                    Case "CCCCC"
                        planCInfo = planParts(0) & " " & planParts(1) & " " & planParts(2)
                        planCCost = planParts(3)
                End Select
            End If
        ' 无效文本直接跳过，不处理
        Else
            ' 空块，忽略无效内容
        End If
    Next i
    
    ' 自动调整目标表列宽，提升可读性
    wsDest.Columns.AutoFit
    
    MsgBox "数据规整完成！", vbInformation
End Sub

代码逻辑说明 #

1. 初始化工作表：创建新工作表并写入指定表头，设置表头样式；
2. 遍历源数据：逐行读取原始数据，通过文本匹配判断行类型；
3. 发票起始处理：遇到INVOICE NO.行时，提取发票号并重置所有Plan变量；
4. Plan行处理：识别Plan行后拆分内容，根据Plan类型存入对应的变量；
5. 总计行处理：遇到Total for行时，将当前发票的所有信息写入目标表，并移动到下一行准备存储下一个发票；
6. 无效文本处理：直接跳过非发票、非Plan、非总计的行。

更优实现方案（使用字典存储） #

如果未来可能新增Plan类型，或者希望代码更易维护，可以使用Scripting.Dictionary来存储每个发票的信息，避免定义大量独立变量：

Sub ConvertInvoiceDataWithDictionary()
    Dim wsSource As Worksheet, wsDest As Worksheet
    Dim lastRow As Long, i As Long, destRow As Long
    Dim currentInvoice As String
    Dim invoiceDict As Object
    Dim totalAmount As String
    
    Set wsSource = ActiveSheet
    Set wsDest = ThisWorkbook.Sheets.Add(After:=wsSource)
    wsDest.Name = "规整发票数据_字典版"
    
    ' 批量写入表头
    With wsDest
        .Range("A1:H1") = Array("Invoice No", "Plan AAAAA", "Plan AAAAA Cost", _
                               "Plan BBBBB", "Plan BBBBB Cost", "Plan CCCCC", _
                               "Plan CCCCC Cost", "Total")
        .Rows(1).Font.Bold = True
    End With
    destRow = 2
    
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    ' 创建字典对象存储当前发票的Plan信息
    Set invoiceDict = CreateObject("Scripting.Dictionary")
    
    For i = 1 To lastRow
        Dim cellValue As String
        cellValue = Trim(wsSource.Cells(i, "A").Value)
        
        If InStr(1, cellValue, "INVOICE NO.", vbTextCompare) > 0 Then
            currentInvoice = Split(cellValue, " ")(2)
            ' 初始化字典，为每个Plan的信息和成本设置空值
            invoiceDict("PlanA_Info") = ""
            invoiceDict("PlanA_Cost") = ""
            invoiceDict("PlanB_Info") = ""
            invoiceDict("PlanB_Cost") = ""
            invoiceDict("PlanC_Info") = ""
            invoiceDict("PlanC_Cost") = ""
        ElseIf InStr(1, cellValue, "Total for", vbTextCompare) > 0 Then
            totalAmount = Split(cellValue, " ")(3)
            ' 将字典中的数据写入目标表
            With wsDest
                .Cells(destRow, "A") = currentInvoice
                .Cells(destRow, "B") = invoiceDict("PlanA_Info")
                .Cells(destRow, "C") = invoiceDict("PlanA_Cost")
                .Cells(destRow, "D") = invoiceDict("PlanB_Info")
                .Cells(destRow, "E") = invoiceDict("PlanB_Cost")
                .Cells(destRow, "F") = invoiceDict("PlanC_Info")
                .Cells(destRow, "G") = invoiceDict("PlanC_Cost")
                .Cells(destRow, "H") = totalAmount
            End With
            destRow = destRow + 1
        ElseIf InStr(1, cellValue, "Plan ", vbTextCompare) > 0 Then
            Dim planParts As Variant
            planParts = Split(cellValue, " ")
            If UBound(planParts) >= 3 Then
                Select Case planParts(1)
                    Case "AAAAA"
                        invoiceDict("PlanA_Info") = planParts(0) & " " & planParts(1) & " " & planParts(2)
                        invoiceDict("PlanA_Cost") = planParts(3)
                    Case "BBBBB"
                        invoiceDict("PlanB_Info") = planParts(0) & " " & planParts(1) & " " & planParts(2)
                        invoiceDict("PlanB_Cost") = planParts(3)
                    Case "CCCCC"
                        invoiceDict("PlanC_Info") = planParts(0) & " " & planParts(1) & " " & planParts(2)
                        invoiceDict("PlanC_Cost") = planParts(3)
                End Select
            End If
        End If
    Next i
    
    wsDest.Columns.AutoFit
    MsgBox "数据规整完成！", vbInformation
End Sub

方案优势 #

• 扩展性强：新增Plan类型时，只需在字典中添加对应的键，修改表头和Select Case分支即可，无需新增大量变量；
• 代码更整洁：用字典统一管理当前发票的所有信息，避免变量过多导致代码混乱；
• 逻辑一致：核心处理逻辑和基础版本相同，只是存储方式更高效。

内容的提问来源于stack exchange，提问作者ReignOfComputer