Question

我对此进行了广泛研究，但似乎无法找到解决方案。我正在尝试创建一个宏来比较不同工作表上两个表之间的数据，并使用唯一标识符突出显示差异。

以下是一个例子：

工作表1（数据集1）

UniqueID | Name |  Date  |  Status
----------------------------------------
| 1230 | Bob   | 1/1/2016  | Denied    
| 6985 | Mike  | 1/6/2016  | Pending    
| 4442 | Will  | 1/9/2016  |  Approved

工作表2（数据集2）

UniqueID | Name |  Date  |  Status
----------------------------------------
| 1230 | Bob   | 1/1/2016  | Denied    
| 6985 | Mike  | 1/6/2016  | Approved    
| 4442 | Will  | 2/27/2016 |  Approved

在这种情况下，宏将使用数据集之间的共享唯一ID和字段名称，并确定两个更改：一个到状态字段，一个到日期字段。

这可能吗？谢谢！

Answer 1

如果您正在寻找VBA解决方案，那么

如果数据集1位于工作表Sheet1中，数据集2位于工作表Sheet2中，则以下代码将突出显示红色差异。

Sub foo()

For i = 2 To 50 'considering 50 rows in Sheet1
    For j = 2 To 50 'considering 50 rows in Sheet2
        If Sheets("Sheet1").Cells(i, 1).Value = Sheets("Sheet2").Cells(j, 1).Value Then
            For k = 1 To 4
                If Sheets("Sheet1").Cells(i, k).Value <> Sheets("Sheet2").Cells(j, k).Value Then
                    Sheets("Sheet1").Cells(i, k).Interior.Color = RGB(255, 0, 0)
                End If
            Next k
        End If
    Next j
Next i

End Sub

Answer 2

只是条件格式化会像你这样做：

=B2<>INDEX(H$2:H$4,MATCH($A2,$G$2:$G$4,0))

您需要根据您的床单更改范围我使用的布局看起来像这样：

Answer 3

如果根据您的示例，您的数据集的UniqueID列彼此匹配，那么您可以编写如下代码：

Option Explicit

Sub main1()
    Dim ds1 As Range, ds2 As Range, row As Range, col As Range, f As Range

    Set ds1 = Worksheets("DataSet1").Range("A1").CurrentRegion '<--| change "DataSet1" to your actual "Data Set 1" sheet name
    Set ds2 = Worksheets("DataSet2").Range("A1").CurrentRegion '<--| change "DataSet2" to your actual "Data Set 2" sheet name

    For Each row In ds1.Columns(1).Cells '<--| loop through "Data Set 1" "UniqueID" values (in its column 1)
        For Each col In ds1.Rows(row.row).Cells '<--| ...loop through "Data Set 1" "UniqueID" row cells...
            If col.Value <> ds2(col.row, col.Column) Then '<--| ... if current cell value doesn't match corresponding "Data Set 2" one, then ...
                col.Interior.Color = RGB(255, 0, 0) '<--| ...mark "Data Set 1" current cell...
                ds2(col.row, col.Column).Interior.Color = RGB(255, 0, 0) '<--| ...mark corresponding "Data Set 2" one
            End If
        Next col
    Next row
End Sub

否则，您必须首先找到Data Set 1＆＃34; UniqueID＆＃34; Data Set 2第一列中的相应单元格，如下所示：

Option Explicit

Sub main2()
    Dim ds1 As Range, ds2 As Range, row As Range, col As Range, f As Range

    Set ds1 = Worksheets("DataSet1").Range("A1").CurrentRegion '<--| change "DataSet1" to your actual "Data Set 1" sheet name
    Set ds2 = Worksheets("DataSet2").Range("A1").CurrentRegion '<--| change "DataSet2" to your actual "Data Set 2" sheet name

    For Each row In ds1.Columns(1).Cells '<--| loop through "Data Set 1" "UniqueID" values (in its column 1)
        Set f = ds2.Columns(1).Find(what:=row.Value, LookIn:=xlValues, lookat:=xlWhole) '<--| look for current UniqueID in "Data Set 2" column 1
        If Not f Is Nothing Then '<-- if "Data Set 1" "UniqueID" found in "Data Set 2", then...
            For Each col In ds1.Rows(row.row).Cells '<--| ...loop through "Data Set 1" "UniqueID" row cells...
                If col.Value <> ds2(col.row, col.Column) Then '<--| ... if current cell value doesn't match corresponding "Data Set 2" one, then ...
                    col.Interior.Color = RGB(255, 0, 0) '<--| ...mark "Data Set 1" current cell...
                    ds2(col.row, col.Column).Interior.Color = RGB(255, 0, 0) '<--| ...mark corresponding "Data Set 2" one
                End If
            Next col
        End If
    Next row
End Sub

Answer 4

您应该在下面尝试此代码。

Sub Compare2WorkSheets(ws1 As Worksheet, ws2 As Worksheet)  
Dim ws1row As Long, ws2row As Long, ws1col As Integer, ws2col As Integer
Dim maxrow As Long, maxcol As Integer, colval1 As String, colval2 As     String
Dim report As Workbook, difference As Long
Dim row As Long, col As Integer
Set report = Workbooks.Add
With ws1.UsedRange
ws1row = .Rows.Count
ws1col = .Columns.Count
End With
With ws2.UsedRange
ws2row = .Rows.Count
ws2col = .Columns.Count
End With
maxrow = ws1row
maxcol = ws1col
If maxrow < ws2row Then maxrow = ws2row
If maxcol < ws2col Then maxcol = ws2col
difference = 0
For col = 1 To maxcol
  For row = 1 To maxrow
  colval1 = ""
  colval2 = ""
  colval1 = ws1.Cells(row, col).Formula
  colval2 = ws2.Cells(row, col).Formula
  If colval1 <> colval2 Then
 difference = difference + 1
 Cells(row, col).Formula = colval1 & "<> " & colval2
 Cells(row, col).Interior.Color = 255
 Cells(row, col).Font.ColorIndex = 2
 Cells(row, col).Font.Bold = True
  End If
Next row
Next col
Columns("A:B").ColumnWidth = 25
report.Saved = True
If difference = 0 Then
report.Close False
End If
Set report = Nothing
MsgBox difference & " cells contain different data! ", vbInformation,     "Comparing Two Worksheets"
End Sub

Private Sub CommandButton1_Click()
'Compare2WorkSheets Worksheets("Sheet1"), Worksheets("Sheet2")
Set myWorkbook1 = Workbooks.Open("C:\familycomputerclub-website\Excel2007        \testcompare2.xlsx")
Compare2WorkSheets Workbooks("testcompare1.xlsm").Worksheets("Sheet1"),         myWorkbook1.Worksheets("Sheet1")
End Sub

通过VBA使用唯一标识符显示两个数据集之间的差异？

4 个答案: