Vba 比较两个工作表并更新

我正在尝试使用VBA比较Excel中的两个工作表

列完全相同，但行数不同

表1将与表2进行比较，并根据表2中的数据进行更新

我需要例程在第一张图纸的数据底部添加新条目，它需要跳过Sheet1中的行，但不在Sheet2中，如果Sheet1中的单元格与Sheet2中的单元格不同，它需要更新现有行

我正在使用dictionary对象来比较“键”

这是我到目前为止所做的，它并没有真正起作用。我认为这是因为它只是检查和更新每一行，而不是先检查整个专栏

 Sub compareSheets()
        Dim dict1, dict2 As Object
        Set dict1 = CreateObject("Scripting.Dictionary")
        Set dict2 = CreateObject("Scripting.Dictionary")

        Dim maxRows1, maxRows2 As Long
        Dim i, ii, j, k As Integer

        maxRows1 = Worksheets("Sheet1").UsedRange.Rows.Count

        For i = 2 To maxRows1

          Dim cell1 As String

          cell1 = Worksheets("Sheet1").cells(i, 2).Text & " " & Worksheets("Sheet1").cells(i, 11).Text

            If Not dict1.exists(cell1) Then
                dict1.Add cell1, cell1
            End If

        Next i

        maxRows2 = Worksheets("Sheet2").UsedRange.Rows.Count

        For ii = 2 To maxRows2

            Dim cell2 As String

            cell2 = Worksheets("Sheet2").cells(ii, 11).Text

            If Not dict2.exists(cell2) Then
                dict2.Add cell2, cell2
            End If

        Next ii

        Dim rng As Range

        For j = 2 To maxRows2

            If Not dict1.exists(Worksheets("Sheet2").cells(j, 11).Text) Then
                Worksheets("Sheet2").Range("A" & j & ":" & "Z" & j).Copy
                Worksheets("Sheet1").Range("A" & maxRows1 + 1).Insert
                Worksheets("Sheet1").Range("A" & maxRows1 + 1).Interior.Color = RGB(255, 255, 0)
                Worksheets("Sheet1").Range("U" & maxRows1 + 1) = "INCH"
                Worksheets("Sheet1").Range("Q" & maxRows1 + 1) = "FPM"
                Worksheets("Sheet1").Range("S" & maxRows1 + 1) = "INCHES WIDE"

                Worksheets("Sheet2").Range("K" & j) = Replace(Worksheets("Sheet2").Range("K" & j), Worksheets("Sheet2").Range("B" & j), "")
                Worksheets("Sheet1").Range("K" & maxRows1 + 1) = Trim(Worksheets("Sheet2").Range("K" & j))

                maxRows1 = Worksheets("Sheet1").UsedRange.Rows.Count

            ElseIf Not dict2.exists(Worksheets("Sheet1").cells(j, 2).Text & " " & Worksheets("Sheet1").cells(j, 11).Text) Then

                j = j

            ElseIf dict1.exists(Worksheets("Sheet2").cells(j, 11).Text) Then
                For k = 3 To 26
                    If Not k = 11 Then
                        If Not Worksheets("Sheet1").cells(j, k).Text = Worksheets("Sheet2").cells(j, k).Text Then
                             Worksheets("Sheet1").cells(j, k) = Worksheets("Sheet2").cells(j, k)
                        End If
                    End If
                Next k
            End If

        Next j

---

您可以通过Microsoft Query或my：

---

您是否逐行检查了代码，以了解它在何处没有像您预期的那样执行？

(SELECT T1.TestName, T2.TestVal FROM [Sheet1$] as T1 INNER JOIN [Sheet2$] as T2 ON T1.TestName = T2.TestName) 
UNION ALL
(SELECT T2.TestName, T2.TestVal FROM [Sheet2$] AS T2 LEFT OUTER JOIN [Sheet1$] as T1 ON T1.TestName = T2.TestName WHERE T1.TestName IS NULL)
UNION ALL
(SELECT T1.TestName, T1.TestVal FROM [Sheet1$] AS T1 LEFT OUTER JOIN [Sheet2$] as T2 ON T1.TestName = T2.TestName WHERE T2.TestName IS NULL)