比较两个工作表并更新答案

【问题标题】：Comparing Two Worksheets and Updating比较两个工作表并更新
【发布时间】：2014-08-04 21:08:21
【问题描述】：

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

列完全相同，但行数不同。

Sheet1 将与 Sheet2 进行比较，并根据 Sheet2 中的数据进行更新。

我需要例程在第一张表的数据底部添加新条目，它需要跳过 Sheet1 中的行，而不是 Sheet2 中的行，如果 Sheet1 中的单元格不同，它需要更新现有行来自 Sheet2。

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

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

 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

【问题讨论】：

您是否逐行逐行检查代码以准确查看其未按预期执行的位置？

标签： vba excel

【解决方案1】：

您可以通过 Microsoft Query 或我的SQL Add-in：

(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)

【讨论】：