如何用Excel VBA按W/S对应数量和日期拆分行并分配注释

问题背景 #

现有Excel数据中，Comments列包含类似COMMIT: 2 W/S 09/29 + 2 W/S 09/30的内容，对应Demand Qty的货物分批次按日期发货。已通过VBA代码将行按数量拆分为每行Qty=1的形式，但拆分后所有行的Comments内容未同步更新，需要从原注释中提取各批次的数量和日期，为每一行分配对应的W/S 日期注释，同时兼容国际机构提供的不同注释格式。

修改后的完整VBA代码 #

Sub ExpandRowsWithComments()
    Dim dat As Variant
    Dim i As Long, j As Long, k As Long
    Dim rw As Range
    Dim rng As Range
    Dim regex As Object
    Dim matches As Object, match As Object
    Dim batchQty() As Integer, batchDate() As String
    Dim currentRow As Long, totalRows As Long
    
    ' 初始化正则表达式，匹配"数字 W/S 日期"的核心结构
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True
    regex.Pattern = "(\d+)\s+W/S\s+(\d{1,2}/\d{1,2})"
    
    Set rng = ActiveSheet.UsedRange
    dat = rng
    totalRows = UBound(dat, 1)
    
    On Error Resume Next
    ' 从下往上处理行，避免插入行影响索引
    For i = totalRows To 2 Step -1
        If dat(i, 3) > 1 Then
            Set rw = rng.Rows(i).EntireRow
            ' 解析当前行的Comments，提取批次信息
            Set matches = regex.Execute(dat(i, UBound(dat, 2)))
            If matches.Count > 0 Then
                ' 存储各批次的数量和日期
                ReDim batchQty(1 To matches.Count)
                ReDim batchDate(1 To matches.Count)
                For j = 0 To matches.Count - 1
                    batchQty(j + 1) = CInt(matches(j).SubMatches(0))
                    batchDate(j + 1) = matches(j).SubMatches(1)
                End If
                
                ' 插入新行并复制内容
                rw.Offset(1, 0).Resize(dat(i, 3) - 1).Insert
                rw.Copy rw.Offset(1, 0).Resize(dat(i, 3) - 1)
                ' 设置所有拆分后的行Qty为1
                rw.Cells(1, 3).Resize(dat(i, 3), 1) = 1
                
                ' 为每一行分配对应的日期注释
                currentRow = rw.Row
                k = 1
                For j = currentRow To currentRow + dat(i, 3) - 1
                    ' 按批次数量循环分配日期
                    If batchQty(k) > 0 Then
                        Cells(j, UBound(dat, 2)).Value = "W/S " & batchDate(k)
                        batchQty(k) = batchQty(k) - 1
                    Else
                        k = k + 1
                        Cells(j, UBound(dat, 2)).Value = "W/S " & batchDate(k)
                        batchQty(k) = batchQty(k) - 1
                    End If
                Next j
            End If
        End If
    Next i
    Set regex = Nothing
End Sub

代码说明 #

• 正则解析注释：使用正则表达式(\d+)\s+W/S\s+(\d{1,2}/\d{1,2})匹配注释中的核心批次信息，兼容不同前缀（如COMMIT:）和分隔符（+、逗号等）
• 批次数据存储：将提取到的各批次数量和日期分别存入数组，方便后续分配
• 逐行分配注释：拆分完成后，按批次数量顺序为每一行匹配对应的W/S 日期注释，确保每一行的注释与实际发货批次对应
• 从下往上处理：避免插入新行导致的索引混乱，保证原数据处理顺序正确

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