Excel VBA - 检查Sheet1中的值对Sheet2，然后复制备注如果匹配

Question

我有两张纸。我想检查一列中的值与第二张表中同一列中的值。如果它们匹配，那么我想将字符串数据从Notes列迁移到新工作表。 （基本上我看到上周的票号是否在本周仍然有效，并且从上周开始记录）。

我尝试使用以下代码执行此操作（使用列Z表示数据，BE表示注释）：

Sub Main()

Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")

Dim partNo2 As Range
Dim partNo1 As Range
Dim partNo3 As Range


For Each partNo2 In ws1.Range("Z1:Z" & ws1.Range("Z" & Rows.Count).End(xlUp).Row)
    For Each partNo1 In ws2.Range("Z1:Z" & ws2.Range("Z" & Rows.Count).End(xlUp).Row)
     For Each partNo3 In ws1.Range("BE1:BE" & ws2.Range("BE" & Rows.Count).End(xlUp).Row)
        If StrComp(Trim(partNo2), Trim(partNo1), vbTextCompare) = 0 Then
            ws2.Range("BE" & partNo1.Row) = partNo3
        End If
        Next
    Next
Next

'now if no match was found then put NO MATCH in cell
For Each partNo1 In ws2.Range("E1:F" & ws2.Range("A" & Rows.Count).End(xlUp).Row)
    If IsEmpty(partNo1) Then partNo1 = ""
Next

End Sub

Answer 1

未测试：

Sub Main()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range, rng2 As Range
    Dim c As Range, f As Range

    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")

    Set rng1 = ws1.Range("Z1:Z" & ws1.Range("Z" & Rows.Count).End(xlUp).Row)
    Set rng2 = ws2.Range("Z1:Z" & ws2.Range("Z" & Rows.Count).End(xlUp).Row)

    For Each c In rng1.Cells
        Set f = rng2.Find(c.Value, , xlValues, xlWhole)
        If Not f Is Nothing Then
            f.EntireRow.Cells(, "BE").Value = c.EntireRow.Cells(, "BE").Value
        End If
    Next c

    'now if no match was found then put NO MATCH in cell
    For Each c In ws2.Range("E1:F" & ws2.Range("A" & Rows.Count).End(xlUp).Row)
        If Len(c.Value) = 0 Then c.Value = "NO MATCH"
    Next

End Sub

Answer 2

这实现了相同的结果（可能除了底部的E＆amp; F列与NO MATCH之外）。它只是一种不同的方式。我没有使用范围，只是查看每个单元格并直接比较它。

<强>试验：

Sub NoteMatch()

Dim lastRow1 As Long
Dim lastRow2 As Long
Dim tempVal As String

    lastRow1 = Sheets("Sheet1").Range("Z" & Rows.Count).End(xlUp).row
    lastRow2 = Sheets("Sheet2").Range("Z" & Rows.Count).End(xlUp).row

    For sRow = 2 To lastRow1
        tempVal = Sheets("Sheet1").Cells(sRow, "Z").Text

        For tRow = 2 To lastRow2
            If Sheets("Sheet2").Cells(tRow, "Z") = tempVal Then
                Sheets("Sheet2").Cells(tRow, "BE") = Sheets("Sheet1").Cells(sRow, "BE")
            End If
        Next tRow
    Next sRow

Dim match As Boolean
'now if no match was found, then put NO MATCH in cell
    For lRow = 2 To lastRow2
        match = False
        tempVal = Sheets("Sheet2").Cells(lRow, "Z").Text

        For sRow = 2 To lastRow1
            If Sheets("Sheet1").Cells(sRow, "Z") = tempVal Then
                match = True
            End If
        Next sRow

        If match = False Then
            Sheets("Sheet2").Cells(lRow, "BE") = "NO MATCH"
        End If
    Next lRow
End Sub