Excel VBA循环匹配列内容时错误返回前一行，如何解决？

问题描述 #

我用VBA检查E列（行X）内容是否与B列（行Y）内容匹配。例如X行E列值为'a'时，需查找B列中是否存在'a'。假设B列有4行值为'a'，需通过另一条件确定目标行Y（比如第3行），但代码返回的是第2行（目标行的前一行），预期结果应为X行E列的'a'匹配Y行B列的'a'。

原代码 #

Sub CaseOneTwoandFour()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim componentNames As New Collection
    Dim cell As Range
    Dim item As Variant
    Dim foundRow As Variant
    Dim i As Long
    Dim j As Long
    Dim cellValue As Variant
    Dim matchRow As Long
    Dim matchFound As Boolean
    Dim tempValue As Variant
    Dim initialRowColor As Long
    
    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' Find the last row
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' Loop through each cell in column A and add unique component names to the collection
    On Error Resume Next
    For Each cell In ws.Range("A5:A" & lastRow)
        If cell.Value <> "" Then
            componentNames.Add cell.Value, CStr(cell.Value)
        End If
    Next cell
    On Error GoTo 0
    
    For Each item In componentNames
        ' Find the row with the specified component name in column A
        foundRow = Application.Match(item, ws.Range("A5:A" & lastRow), 0)
        If IsError(foundRow) Then Exit Sub
        
        ' Loop through rows below the found component name row
        For i = 5 To lastRow
            cellValue = ws.Cells(i, 3).Value
            
            ' Check if columns D and E or columns F and G have content
            If (Len(Trim(ws.Cells(i, 4).Value)) > 0 And Len(Trim(ws.Cells(i, 5).Value)) > 0) Or _
               (Len(Trim(ws.Cells(i, 6).Value)) > 0 And Len(Trim(ws.Cells(i, 7).Value)) > 0) Then
                
                matchFound = False
                
                ' Check if contents from either column E (5) or G (7) match any cell in column B (2)
                For j = 5 To ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
                    If StrComp(ws.Cells(j, 2).Value, ws.Cells(i, 5).Value, vbBinaryCompare) = 0 Or _
                       StrComp(ws.Cells(j, 2).Value, ws.Cells(i, 7).Value, vbBinaryCompare) = 0 Then
                        
                        If Not ws.Rows(j).Find(What:=cellValue, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
                            matchRow = j
                            matchFound = True
                            Exit For
                        End If
                    End If
                Next j
                
                If matchFound Then
                    ' Ensure matchRow is set before trying to access it
                    If matchRow > 0 Then
                        If Len(Trim(ws.Cells(matchRow, 5).Value)) > 0 Then
                            tempValue = ws.Cells(matchRow, 5).Value
                        ElseIf Len(Trim(ws.Cells(matchRow, 7).Value)) > 0 Then
                            tempValue = ws.Cells(matchRow, 7).Value
                        End If
                        
                        initialRowColor = ws.Cells(i, 8).Interior.Color
                        If StrComp(ws.Cells(i, 2).Value, tempValue, vbBinaryCompare) = 0 Then
                            ws.Cells(i, 8).Interior.Color = RGB(0, 255, 0) ' Green color for initial row
                            ws.Cells(matchRow, 8).Interior.Color = RGB(0, 255, 0) ' Green color for matched row
                        Else
                            ws.Cells(i, 8).Interior.Color = RGB(255, 0, 0) ' Red color
                            ws.Cells(i, 9).Value = "Wrong Connection"
                        End If
                    End If
                Else
                    ws.Cells(i, 8).Interior.Color = RGB(255, 0, 0) ' Red color
                    ws.Cells(i, 9).Value = "Wrong Connection"
                End If
            End If
            
            ' Highlight red if E or G has content but D or F does not respectively
            If (Len(Trim(ws.Cells(i, 5).Value)) > 0 And Len(Trim(ws.Cells(i, 4).Value)) = 0) Or _
               (Len(Trim(ws.Cells(i, 7).Value)) > 0 And Len(Trim(ws.Cells(i, 6).Value)) = 0) Then
                ws.Cells(i, 8).Interior.Color = IIf(StrComp(item, "connector", vbBinaryCompare) = 0, RGB(255, 255, 0), RGB(255, 0, 0))
                If ws.Cells(i, 1).Value = "connector" Then ws.Cells(i, 8).Interior.Color = RGB(255, 255, 0)
                ws.Cells(i, 9).Value = "One of the connections is absent for Connector"
            End If
            
            ' Highlight red if all columns D, E, F, and G are empty
            If Len(Trim(ws.Cells(i, 4).Value)) = 0 And Len(Trim(ws.Cells(i, 5).Value)) = 0 And _
               Len(Trim(ws.Cells(i, 6).Value)) = 0 And Len(Trim(ws.Cells(i, 7).Value)) = 0 Then
                ws.Cells(i, 8).Interior.Color = RGB(255, 255, 0) ' Red color
                ws.Cells(i, 9).Value = "There is interaction with non-terminal component (No Producer or Consumer)"
            End If
            
            ' If all columns D, E, F, and G have content, give red color
            If Len(Trim(ws.Cells(i, 4).Value)) > 0 And Len(Trim(ws.Cells(i, 5).Value)) > 0 And _
               Len(Trim(ws.Cells(i, 6).Value)) > 0 And Len(Trim(ws.Cells(i, 7).Value)) > 0 Then
                ws.Cells(i, 8).Interior.Color = RGB(255, 0, 0) ' Red color
            End If
            
        Next i
    Next item
End Sub

问题原因 #

1. 循环终止逻辑错误：原代码中遍历B列的For j循环，一旦找到第一个符合B列值匹配E/G列值且行内包含cellValue的行，就立即执行Exit For终止循环，导致返回的是第一个匹配项，而非你需要的目标行（比如第3个匹配项）。
2. 目标筛选条件缺失：你提到的"另一条件（确定第3行）"没有在代码中实现，当前逻辑仅筛选第一个满足基础条件的行，自然会返回更早出现的行（比如第2行）。

修复方案 #

1. 明确目标筛选规则 #

先定义清楚你的"另一条件"，比如：

• 取B列中第N个匹配E列值的行（如第3个）
• 基于其他列（如C列）的特定值筛选目标行
• 取最后一个匹配的行

2. 修改匹配逻辑：收集所有符合条件的行再筛选 #

将原有的j循环部分替换为以下代码，先收集所有符合基础条件的行号，再根据你的规则选择目标行：

' 替换原j循环及后续matchFound判断部分
matchFound = False
Dim matchRows As Collection
Set matchRows = New Collection

' 收集所有符合条件的行号
For j = 5 To ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    If StrComp(ws.Cells(j, 2).Value, ws.Cells(i, 5).Value, vbBinaryCompare) = 0 Or _
       StrComp(ws.Cells(j, 2).Value, ws.Cells(i, 7).Value, vbBinaryCompare) = 0 Then
        If Not ws.Rows(j).Find(What:=cellValue, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
            matchRows.Add j
        End If
    End If
Next j

' 根据自定义条件选择目标行
If matchRows.Count > 0 Then
    ' 示例：取第3个匹配项，若不足则取最后一个
    If matchRows.Count >= 3 Then
        matchRow = matchRows(3)
    Else
        matchRow = matchRows(matchRows.Count)
    End If
    matchFound = True
End If

3. 保留后续标记逻辑 #

原有的颜色标记、错误提示逻辑无需修改，确保基于正确的matchRow执行即可。

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