VBA Nested If, Then, Else Loop That Copies Non-Matching Entries

问题

I have some code here I have done to match a range of cells on one sheet(CRD), compare them to a range of cells on another sheet(PRD), and highlight the cells in column A of the first sheet(PRD) that have a matching range.

I also want to copy and paste the range in column A of the first sheet(CRD) for ranges that do not match the second sheet(PRD) onto a third sheet(Sheet 1). I am sure it is my structure of the ends and exits and next statements I am using but I can not figure this out after Googling extensively. Thanks for any help or critique of my question/problem.

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

End Sub

回答1:

I think you have too many for loops. I'm assuming that you just want to check for a match on the other sheet and then mark green then copy somewhere else if it's not found.

I looked like you were looping through for a match and then looping through again for no match. You just need to loop through for a match and record if something was found or not.

Normally I would use a variable for found but since you are setting the colour to green, I thought I'd use that in my if statement instead. (I hope it works as I wasn't able to test the code).

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

Also, you could change the if statement to concatenate the first 6 cells together to compare them without all the 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

1 more thing

Concatenating some cells into a column using a formula means that you can use a vlookup formula in another column to check if the data exists on the another sheet without a macro.

来源：https://stackoverflow.com/questions/49825676/vba-nested-if-then-else-loop-that-copies-non-matching-entries

标签

excel

vba

excel-vba