VBA在具有不同行索引的两个工作表之间匹配行

Sub MatchRowsBetweenSheets()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim i As Long
    Dim j As Long
    
    ' 设置工作表
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")  ' 工作表1
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")  ' 工作表2
    Set ws3 = ThisWorkbook.Worksheets.Add         ' 工作表3
    
    ' 获取工作表1和工作表2的最后一行
    lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    lastRow2 = ws2.Cells(ws2.Rows.Count, "B").End(xlUp).Row
    
    ' 在工作表3中创建表头
    ws3.Range("A1:D1").Value = Array("行索引", "列1", "列2", "列3")
    
    ' 循环遍历工作表1中的每一行
    For i = 2 To lastRow1
        Dim rowIndex As String
        Dim matchedRow As Range
        
        rowIndex = ws1.Cells(i, "A").Value
        
        ' 在工作表2中查找匹配的行
        Set matchedRow = ws2.Columns("B:B").Find(What:=rowIndex, LookIn:=xlValues, LookAt:=xlWhole)
        
        ' 判断是否找到匹配的行
        If Not matchedRow Is Nothing Then
            ' 复制匹配的行到工作表3中
            j = ws3.Cells(ws3.Rows.Count, "A").End(xlUp).Row + 1
            ws2.Rows(matchedRow.Row).Copy Destination:=ws3.Range("A" & j)
            ws1.Rows(i).Copy Destination:=ws3.Range("B" & j)
        Else
            ' 如果未找到匹配的行，可以在工作表3中插入标记或其他操作
            j = ws3.Cells(ws3.Rows.Count, "A").End(xlUp).Row + 1
            ws3.Range("A" & j).Value = rowIndex
            ws3.Range("B" & j).Value = "未匹配到对应的行"
        End If
    Next i
End Sub