Do While循环求和粘贴VBA宏仅部分生效问题求助

• 判断客户采用净额（nett）或总额（gross）模式
• 净额模式（Y）：对该客户所有已排序的行数据求和，结果写入「EB Bulk Upload」工作表对应列，直接处理下一个客户
• 总额模式（N）：直接复制当前行数据到目标列，处理下一行

Sub netting()
    
    Dim od As Worksheet
    Dim eb As Worksheet
    Dim mapping As Worksheet
    Dim client As String
    Dim currentvalue As Double
    Dim row As Long
    Dim i As Long
    Dim p As Long

    Set od = ThisWorkbook.Sheets("Original Data")
    Set eb = ThisWorkbook.Sheets("EB Bulk Upload")
    Set mapping = ThisWorkbook.Sheets("Mapping")
    
    lastrow = od.Cells(od.Rows.Count, "H").End(xlUp).row
    
    i = 20
    p = 2
    
    For i = 20 To lastrow
    
    Dim clientid As String
    clientid = od.Cells(i, "E").Value
    
    Dim nettvalue As Variant
    nettvalue = Application.WorksheetFunction.XLookup(clientid, mapping.Range("$B$2:$B$287" & lastRow), mapping.Range("$C$2:$C$287" & lastRow))
        
            If nettvalue = "Y" Then
                Dim sum As Double
                sum = 0
                
                Do While od.Cells(i, "E").Value = clientid
                    sum = sum + od.Cells(i, "H").Value
                    i = i + 1
                Loop
            
                eb.Cells(p, "F").Value = sumValue
                
            ElseIf nettvalue = "N" Then
                
                eb.Cells(p, "F").Value = od.Cells(i, "H").Value
                
            End If
            
            i = i + 1
            p = p + 1
            
    Next i


End Sub

• 第一个客户数据处理正确
• 第二个客户会跳过第21行后再对后续行求和
• 后续客户的宏逻辑不再生效

源数据 #

处理后数据 #

问题根源 #

1. lastRow未声明，且在XLookup范围中错误拼接，导致查询范围超出实际数据
2. Do While循环内已自增i，后续又执行i = i + 1，导致跳过一行
3. 求和后赋值使用未定义的sumValue，应为sum
4. For循环中手动修改循环变量i，导致循环逻辑混乱

修复后的代码 #

Sub netting()
    Dim od As Worksheet, eb As Worksheet, mapping As Worksheet
    Dim lastRowOd As Long, lastRowMap As Long
    Dim i As Long, p As Long
    Dim clientId As String, nettValue As Variant
    Dim sumNett As Double
    
    ' 初始化工作表对象
    Set od = ThisWorkbook.Sheets("Original Data")
    Set eb = ThisWorkbook.Sheets("EB Bulk Upload")
    Set mapping = ThisWorkbook.Sheets("Mapping")
    
    ' 获取源数据和映射表的最后行号
    lastRowOd = od.Cells(od.Rows.Count, "H").End(xlUp).Row
    lastRowMap = mapping.Cells(mapping.Rows.Count, "B").End(xlUp).Row
    
    i = 20 ' 源数据起始行
    p = 2 ' 目标表起始行
    
    ' 改用Do While遍历，避免For循环变量冲突
    Do While i <= lastRowOd
        clientId = od.Cells(i, "E").Value
        
        ' 正确获取客户的净额模式标记
        nettValue = Application.XLookup(clientId, mapping.Range("B2:B" & lastRowMap), mapping.Range("C2:C" & lastRowMap), "NotFound", 0, 1)
        
        If nettValue = "Y" Then
            sumNett = 0
            ' 累加当前客户所有行数据
            Do While i <= lastRowOd And od.Cells(i, "E").Value = clientId
                sumNett = sumNett + od.Cells(i, "H").Value
                i = i + 1
            Loop
            ' 写入求和结果
            eb.Cells(p, "F").Value = sumNett
        ElseIf nettValue = "N" Then
            ' 直接复制当前行数据
            eb.Cells(p, "F").Value = od.Cells(i, "H").Value
            i = i + 1
        End If
        
        p = p + 1
    Loop
End Sub

优化点说明 #

• 声明所有变量，避免隐式类型错误
• 分别获取源数据和映射表的实际最后行号，确保查询范围准确
• 改用Do While循环遍历源数据，避免For循环中修改循环变量导致的逻辑混乱
• 修复求和赋值的变量错误
• 增加边界判断i <= lastRowOd，防止循环超出数据范围

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