Question

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

列完全相同，行数不同。

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

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

我正在使用字典对象来比较'keys'

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

 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

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

比较两个工作表和更新

1 个答案: