如何比较两组字符串？VBA字符串对比功能异常排查

核心问题分析 #

1. 字符串对比逻辑错误：StrComp函数返回数值结果（0=相等，-1/1=不等），原代码用And连接两个StrComp结果做逻辑判断，属于数值运算而非字符串匹配判断，这是导致操作随机执行的根本原因。
2. 插入行后索引未正确调整：插入新行后，原第i行内容下移到i+1行，但代码直接执行i = i + 1，会跳过该行的对比。
3. 循环边界处理不严谨：ws1EndRow在循环中更新，但While i < ws1EndRow的条件会因插入行导致的行数变化出现逻辑漏洞。

修复后的完整代码 #

Option Explicit
Sub CompareValues()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim ws1EndRow As Long, ws2EndRow As Long, i As Long
    Dim dbAMarca As String, dbASubGrupo As String
    Dim dbAQtddVendas As Range, dbAValorVendas As Range
    Dim dbAQtddEstoque As Range, dbAValorEstoque As Range
    Dim dbBMarca As String, dbBSubGrupo As String
    Dim dbBQtddVendas As Range, dbBValorVendas As Range
    Dim dbBQtddEstoque As Range, dbBValorEstoque As Range

    ' 检查工作簿/工作表是否存在
    On Error Resume Next
    Set ws1 = Application.Workbooks("1.xlsx").Sheets("Sheet1")
    Set ws2 = Application.Workbooks("2.xls").Sheets("Sheet2")
    On Error GoTo 0
    If ws1 Is Nothing Or ws2 Is Nothing Then
        MsgBox "目标工作簿或工作表不存在，请检查！", vbExclamation
        Exit Sub
    End If

    i = 4
    ws1EndRow = ws1.UsedRange.Rows(ws1.UsedRange.Rows.Count).Row
    ws2EndRow = ws2.UsedRange.Rows(ws2.UsedRange.Rows.Count).Row

    ' 改用Do循环处理行数变化场景
    Do While i <= ws1EndRow And (i - 1) <= ws2EndRow
        ' 读取ws1当前行数据（去除前后空格避免误判）
        dbASubGrupo = Trim(ws1.Cells(i, "D").Value)
        dbAMarca = Trim(ws1.Cells(i, "E").Value)
        Set dbAQtddVendas = ws1.Cells(i, "F")
        Set dbAValorVendas = ws1.Cells(i, "G")
        Set dbAQtddEstoque = ws1.Cells(i, "M")
        Set dbAValorEstoque = ws1.Cells(i, "O")

        ' 读取ws2对应行数据
        dbBSubGrupo = Trim(ws2.Cells(i - 1, "H").Value)
        dbBMarca = Trim(ws2.Cells(i - 1, "J").Value)
        Set dbBQtddVendas = ws2.Cells(i - 1, "Q")
        Set dbBValorVendas = ws2.Cells(i - 1, "R")
        Set dbBQtddEstoque = ws2.Cells(i - 1, "AF")
        Set dbBValorEstoque = ws2.Cells(i - 1, "AI")

        ' 修正字符串匹配判断逻辑
        If StrComp(dbAMarca, dbBMarca, vbTextCompare) <> 0 Or _
           StrComp(dbASubGrupo, dbBSubGrupo, vbTextCompare) <> 0 Then
            ' 插入新行并设置红色背景
            ws1.Rows(i).EntireRow.Insert
            With ws1.Rows(i).EntireRow
                .Interior.Color = vbRed
                .Cells(1, "D").Value = dbBSubGrupo
                .Cells(1, "E").Value = dbBMarca
            End With
            ' 更新总行数，插入行后行数+1
            ws1EndRow = ws1EndRow + 1
            ' 插入行后，原行下移，保持i不变继续处理
        Else
            ' 对比数值列，不匹配则标黄
            If dbAQtddVendas.Value <> dbBQtddVendas.Value Then
                dbAQtddVendas.Interior.Color = vbYellow
            End If
            If dbAValorVendas.Value <> dbBValorVendas.Value Then
                dbAValorVendas.Interior.Color = vbYellow
            End If
            If dbAQtddEstoque.Value <> dbBQtddEstoque.Value Then
                dbAQtddEstoque.Interior.Color = vbYellow
            End If
            If dbAValorEstoque.Value <> dbBValorEstoque.Value Then
                dbAValorEstoque.Interior.Color = vbYellow
            End If
            ' 匹配成功，移动到下一行
            i = i + 1
        End If
    Loop
End Sub

关键修复点说明 #

1. 字符串对比逻辑修正：使用StrComp(..., vbTextCompare) <> 0判断字符串不匹配，用Or连接两个条件，符合需求中“任一字符串不匹配则插入行”的规则。
2. 插入行索引处理：插入新行后不递增i，确保原行（下移后）能被正常对比，避免数据遗漏。
3. 循环边界优化：改用Do While循环，同时限制ws2的行号边界，防止越界读取。
4. 增加容错处理：检查工作簿/工作表是否存在，避免硬编码名称导致的运行时错误。
5. 空格预处理：对字符串执行Trim操作，避免因首尾空格导致的误判。

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