VBA 嵌套 If, Then, Else 循环复制不匹配的条目

Question

我在这里做了一些代码来匹配一张纸上的一系列单元格（CRD），将它们与另一张纸上的一系列单元格（PRD）进行比较，并突出显示第一张纸的 A 列中的单元格（ PRD) 具有匹配范围。

我还想将与第二张工作表 (PRD) 不匹配的范围复制并粘贴到第三张工作表 (工作表 1) 上的第一张工作表 (CRD) 的 A 列中的范围。我确信这是我正在使用的结束和退出以及下一个语句的结构，但在广泛使用谷歌搜索后我无法弄清楚这一点。感谢您对我的问题/问题的任何帮助或批评。

Sub Loop_Test()

Dim compareRange As Range, toCompare As Range
Dim lastRow1 As Long, lastRow2 As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim i As Long, j As Long, K As Long, L As Long

Dim PasteRow As Long
Dim wsDest As Worksheet

Set ws1 = ThisWorkbook.Worksheets("PRD")
Set ws2 = ThisWorkbook.Worksheets("CRD")
lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

Set wsReport = ThisWorkbook.Worksheets("Sheet1")
Set wsSrc = ActiveSheet

Set compareRange = ws1.Range("A" & lastRow1)
Set toCompare = ws2.Range("A" & lastRow2)

For i = 2 To lastRow2
    For j = 2 To lastRow1
        If ws2.Cells(i, 1) = ws1.Cells(j, 1) _
            And ws2.Cells(i, 2) = ws1.Cells(j, 2) _
            And ws2.Cells(i, 3) = ws1.Cells(j, 3) _
            And ws2.Cells(i, 4) = ws1.Cells(j, 4) _
            And ws2.Cells(i, 5) = ws1.Cells(j, 5) _
            And ws2.Cells(i, 6) = ws1.Cells(j, 6) Then

        ws2.Cells(i, 1).Interior.Color = vbGreen

            Else
For K = 2 To lastRow2
    For L = 2 To lastRow1
        If ws2.Cells(K, 1) <> ws1.Cells(L, 1) _
            And ws2.Cells(K, 2) <> ws1.Cells(L, 2) _
            And ws2.Cells(K, 3) <> ws1.Cells(L, 3) _
            And ws2.Cells(K, 4) <> ws1.Cells(L, 4) _
            And ws2.Cells(K, 5) <> ws1.Cells(L, 5) _
            And ws2.Cells(K, 6) <> ws1.Cells(L, 6) Then

            Set wsDest = wsReport

            With wsDest
                wsSrc.Rows(i).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
        End With

        End If
    Exit For
    Next L
Exit For
Next K
        End If
    Next j
Next i

结束子

Answer 1

我认为你有太多 for 循环。我假设您只想检查另一张纸上的匹配项，然后标记为绿色，如果找不到，则复制到其他地方。

我看起来好像您正在循环匹配匹配，然后再次循环匹配未匹配。您只需要循环查找匹配项并记录是否找到了某些内容。

通常我会为found 使用一个变量，但由于您将颜色设置为绿色，我想我会在我的 if 语句中使用它。 （我希望它可以工作，因为我无法测试代码）。

Sub Loop_Test()

Dim compareRange As Range, toCompare As Range
Dim lastRow1 As Long, lastRow2 As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim i As Long, j As Long, K As Long, L As Long

Dim PasteRow As Long
Dim wsDest As Worksheet

Set ws1 = ThisWorkbook.Worksheets("PRD")
Set ws2 = ThisWorkbook.Worksheets("CRD")
lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

Set wsReport = ThisWorkbook.Worksheets("Sheet1")
Set wsSrc = ActiveSheet

Set compareRange = ws1.Range("A" & lastRow1)
Set toCompare = ws2.Range("A" & lastRow2)

For i = 2 To lastRow2
    For j = 2 To lastRow1
        If ws2.Cells(i, 1) = ws1.Cells(j, 1) _
            And ws2.Cells(i, 2) = ws1.Cells(j, 2) _
            And ws2.Cells(i, 3) = ws1.Cells(j, 3) _
            And ws2.Cells(i, 4) = ws1.Cells(j, 4) _
            And ws2.Cells(i, 5) = ws1.Cells(j, 5) _
            And ws2.Cells(i, 6) = ws1.Cells(j, 6) Then

          ws2.Cells(i, 1).Interior.Color = vbGreen
          Exit For
        End if

   Next j

   ' if not found (not green) then copy
   if ws2.Cells(i, 1).Interior.Color <> vbGreen then
            Set wsDest = wsReport

            With wsDest
                wsSrc.Rows(i).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
        End With


        End If

Next i
End Sub

此外，您可以更改 if 语句以将前 6 个单元格连接在一起，以便在没有所有 Ands 的情况下比较它们。

If ws2.Cells(i, 1) & ws2.Cells(i, 2) & ws2.Cells(i, 3) & ws2.Cells(i, 4) & ws2.Cells(i, 5) & ws2.Cells(i, 6) = ws1.Cells(j, 1) & ws1.Cells(j, 2) & ws1.Cells(j, 3) & ws1.Cells(j, 4) & ws1.Cells(j, 5) & ws1.Cells(j, 6) then

还有一件事

使用公式将一些单元格连接成一列意味着您可以在另一列中使用 vlookup 公式来检查数据是否存在于另一个不使用宏的工作表上。