Question

我正在尝试将sheet2中的列A与sheet1中的columnA进行比较，当匹配时，将行从sheet1复制到sheet3。这是我的代码，但它不起作用。

Sub compareAndCopy()

Dim lastRowE As Integer
Dim lastRowM As Integer
Dim foundTrue As Boolean

' stop screen from updating to speed things up
Application.ScreenUpdating = False

lastRowE = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Row
lastRowF = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row
lastRowM = Sheets("Sheet3").Cells(Sheets("Sheet3").Rows.Count, "B").End(xlUp).Row



For i = 1 To lastRowE
foundTrue = False
For j = 1 To lastRowF

    If Sheets("Sheet2").Cells(i, 1).Value = Sheets("Sheet1").Cells(j, 1).Value Then
        'MsgBox ("didnt find string: " & Sheets("Sheet2").Cells(i, 2).value)
        Sheets("Sheet2").Rows(i).Copy Destination:= _
        Sheets("Sheet3").Rows(lastRowM + 1)

        Exit For
    End If

Next j

If Not foundTrue Then
    lastRowM = lastRowM + 1
    foundTrue = True

End If


Next i

' stop screen from updating to speed things up
Application.ScreenUpdating = True

End Sub

Answer 1

正如Scott Craner所指出的那样，基于lastRowM更新foundTrue无效。每次向Sheet3添加新行时，只要更新foundTrue，就不需要lastRowM。我已将其保存在代码中，以防您执行如果找不到值，则希望显示消息。

Sub compareAndCopy()

    Dim lastRowE As Long
    Dim lastRowF As Long
    Dim lastRowM As Long
    Dim foundTrue As Boolean

    ' stop screen from updating to speed things up
    Application.ScreenUpdating = False

    lastRowE = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Row
    lastRowF = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row
    lastRowM = Sheets("Sheet3").Cells(Sheets("Sheet3").Rows.Count, "B").End(xlUp).Row

    For i = 1 To lastRowE
        foundTrue = False
        For j = 1 To lastRowF

            If Sheets("Sheet2").Cells(i, 1).Value = Sheets("Sheet1").Cells(j, 1).Value Then
                lastRowM = lastRowM + 1
                Sheets("Sheet2").Rows(i).Copy Destination:= _
                           Sheets("Sheet3").Rows(lastRowM)
                foundTrue = True
                Exit For
            End If
        Next j
        'If Not foundTrue Then
        '    MsgBox ("didn't find string: " & Sheets("Sheet2").Cells(i, 2).value)
        'End If
    Next i

    ' stop screen from updating to speed things up
    Application.ScreenUpdating = True
End Sub

Answer 2

遵循你的措辞：

我试图将sheet2中的A列与sheet1中的columnA进行比较匹配，将行从sheet1复制到sheet3。

你可以试试这个

cut

Excel VBA - 比较两列中的值并将匹配的行复制到新工作表

2 个答案: