如果 sheet1 中的列“a”与 sheet2 中的列“a”匹配，则替换 sheet1 中的整行

Question

我想将 sheet1 中的 A 列与 sheet2 中的 A 列进行比较。

如果值匹配，将数据从 sheet2 复制到 sheet1 到匹配值的行中。

示例：

Answer 1

使用字典对象将 sheet2 上的标题名称与 sheet1 上的标题名称匹配。

更新 - 添加修剪以将数字转换为字符串

Option Explicit

Sub Update()

    Const ROW_HEADER = 1

    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastrow As Long, lastcol As Long, r As Long, c As Long
    Dim arID, id As String, n As Long, m As Variant
    
    Dim dictCol As Object, k As String
    Set dictCol = CreateObject("Scripting.Dictionary")
   
   ' profile sheet2 columns
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    With ws2
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        arID = .Range("A1:A" & lastrow).Value2 ' range of iDs
        
        lastcol = .Cells(ROW_HEADER, .Columns.Count).End(xlToLeft).Column
        For c = 1 To lastcol
            k = Trim(.Cells(ROW_HEADER, c)) ' header text
            If dictCol.exists(k) Then
                MsgBox "Duplicate header '" & k & "' at column " & c, vbCritical
                Exit Sub
            ElseIf Len(k) > 0 Then
                dictCol(k) = c ' column number
            End If
        Next
    End With

    For r = 1 To UBound(arID): arID(r, 1) = Trim(arID(r, 1)): Next
    MsgBox dictCol.Count & " columns found on sheet " & ws2.Name, vbInformation
    
    ' update sheet1
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    With ws1
        lastcol = .Cells(ROW_HEADER, .Columns.Count).End(xlToLeft).Column
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For r = 2 To lastrow
            id = Trim(.Cells(r, "A"))
            
            ' locate row on sheet2
            m = Application.Match(id, arID, 0)
            If Not IsError(m) Then
                ' scan columns
                For c = 2 To lastcol
                    k = trim(.Cells(ROW_HEADER, c))
                    ' find col on sheet2
                    If dictCol.exists(k) Then
                        ' update if different
                        If .Cells(r, c) <> ws2.Cells(m, dictCol(k)) Then
                            .Cells(r, c).Interior.Color = RGB(255, 255, 0) ' mark yellow for checking
                            .Cells(r, c) = ws2.Cells(m, dictCol(k))
                            n = n + 1
                         End If
                    Else
                        MsgBox "Column " & k & " not found", vbCritical
                        Exit Sub
                    End If
                Next
            Else
                Debug.Print id, m
            End If
        Next
    End With
    
    ' end
    MsgBox lastrow - 1 & " rows scanned " & vbLf & _
           n & " cells updated", vbInformation
   
End Sub