查找和复制行

• 假设两个工作表都是表格格式，即一行标题，没有空行或空列，并且每个工作表上只有表格（与UsedRange相关）。

Sub UpdateMaster()
    
    ' If this code is located in any of these workbooks then you shouldn't
    ' use its name but 'ThisWorkbook':
    ' 'Set swb = ThisWorkbook', or 'Set dwb = ThisWorkbook'
    ' Also, you should out-comment the 'Close' line until you are sure
    ' that the code works as expected.
    
    ' Define constants.
     
    Const SRC_WORKBOOK As String = "ExtractFile.xlsm"
    Const SRC_WORKSHEET As String = "Sheet1"
    Const SRC_LOOKUP_COLUMN As Long = 1
    Const DST_WORKBOOK As String = "Workbook.xlsm"
    Const DST_WORKSHEET As String = "Sheet1"
    Const DST_LOOKUP_COLUMN As Long = 1
    
    Dim swb As Workbook: Set swb = Workbooks(SRC_WORKBOOK)
    Dim sws As Worksheet: Set sws = swb.Worksheets(SRC_WORKSHEET)
    
    Dim Data() As Variant, srCount As Long, cCount As Long
    
    With sws.UsedRange ' reference the source (table) range
        srCount = .Rows.Count - 1 ' use -1 to exclude headers
        cCount = .Columns.Count
        Data = .Resize(srCount).Offset(1).Value
    End With
    
    Dim dwb As Workbook: Set dwb = Workbooks(DST_WORKBOOK)
    Dim dws As Worksheet: Set dws = dwb.Worksheets(DST_WORKSHEET)
    
    ' Write the values from the dest. lookup column to the dest. lookup array.
    
    Dim lData() As Variant, dfcell As Range, drCount As Long
    
    With dws.UsedRange
        drCount = .Rows.Count - 1 ' use -1 to exclude headers
        Set dfcell = .Cells(1).Offset(drCount + 1)
        lData = .Columns(DST_LOOKUP_COLUMN).Resize(drCount).Offset(1).Value
    End With
    
    ' Write the unique values from the dest. lookup array to a dictionary.
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim dr As Long
    For dr = 1 To drCount
        dict(lData(dr, 1)) = Empty
    Next dr
    
    Erase lData
    dr = 0 ' reset for the next loop
    
    ' Write the not matching values to the top of the array.
    
    Dim sr As Long, c As Long
    
    For sr = 1 To srCount
        If Not dict.Exists(Data(sr, SRC_LOOKUP_COLUMN)) Then
            dr = dr + 1
            For c = 1 To cCount
                Data(dr, c) = Data(sr, c)
            Next c
        End If
    Next sr
    
    Set dict = Nothing
    
    If dr = 0 Then
        MsgBox "Data had already been updated.", vbExclamation
        Exit Sub
    End If
    
    ' Write the top values from the array to the destination range.

    Dim drg As Range: Set drg = dfcell.Resize(dr, cCount)
    drg.Value = Data
    
    dwb.Close SaveChanges:=True

    ' Inform.

    MsgBox "Data updated.", vbInformation

End Sub