Excel，将两个特定的行进行比较，并突出显示差异。

Before commenting on saying that there are similar questions, Ive tried them but they do not work unfortunately

在评论是否有类似的问题之前，我已经试过了，但不幸的是它们不起作用

Hi, this is the first time I am on S.O, rest assured, I have spent hours looking for a solution for this. I have a status column which shows statuses such as, deleted, new, changed. When the status is "changed", I would like to compare that particular row from column E to the last possible column in Excel (XFD) in Sheet3 to columns A to the last possible column in Excel (XFD) in Sheet1 and highlight the cells which are different.

你好，这是我第一次上S。请放心，我已经花了好几个小时来寻找解决办法。我有一个状态列，它显示状态，比如，已删除，新建，已更改。当状态被“改变”时，我想要将在Sheet3中的Excel (XFD)中的特定行与Excel (XFD)中最后一个可能的列(XFD)进行比较，将其与在Sheet1中的最后一个可能的列(XFD)进行比较，并突出显示不同的单元格。

I have found this solution:-

我找到了解决办法:-

Dim diffB As Boolean
  Dim r As Long, c As Integer, m As Integer
  Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
  Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
  Dim rptWB As Workbook, DiffCount As Long
  Application.ScreenUpdating = False
  Application.StatusBar = "Creating the report..."
  Application.DisplayAlerts = True
  With Sheet1.UsedRange
    lr1 = .Rows.Count
    lc1 = .Columns.Count
  End With
  With Sheet3.UsedRange
    lr2 = .Rows.Count
    lc2 = .Columns.Count
  End With
  maxR = lr1
  maxC = lc1
  If maxR < lr2 Then maxR = lr2
  If maxC < lc2 Then maxC = lc2
  DiffCount = 0
  For c = 1 To maxC
    For i = 2 To lr1
      diffB = True
      Application.StatusBar = "Comparing cells " & Format(i / maxR, "0 %") & "..."
        For r = 2 To lr2
          cf1 = ""
          cf2 = ""
          On Error Resume Next
          cf1 = Sheet1.Cells(i, c).FormulaLocal
          cf2 = Sheet3.Cells(r, c).FormulaLocal
          On Error GoTo 0
          If cf1 = cf2 Then
            diffB = False
            Sheet1.Cells(i, c).Interior.ColorIndex = 19
            Sheet1.Cells(i, c).Select
            Selection.Font.Bold = True
            Exit For
          End If
        Next r

     If diffB Then
       DiffCount = DiffCount + 1
       Sheet1.Cells(i, c).Interior.ColorIndex = 0
       Sheet1.Cells(i, c).Select
       Selection.Font.Bold = False
     End If
    Next i
  Next c3
Application.StatusBar = "Formatting the report..."
'Columns("A:IV").ColumnWidth = 10
m = maxR - DiffCount - 1
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox m & " cells contain same values!", vbInformation, _
"Compare " & Sheet1.Name & " with " & Sheet3.Name

However, this compares columns and I do not know how to limit the comparison to column E-XFD in sheet1 to column A-XFD in sheet2.

但是，这个比较了列，我不知道如何限制sheet1中的列E-XFD与sheet2中的A-XFD列的比较。

There are also several sheets in this workbook but I only want to compare sheet1 and sheet2.

在这个工作簿中也有几个表，但是我只想比较sheet1和sheet2。

It will be much appreciated if you guys can help me out :)

如果你们能帮助我，我将不胜感激。

Thanks!

谢谢!

1 个解决方案

#1

Dim lrOne As Integer
Dim lcOne As Integer
Dim lrTwo As Integer
Dim lcTwo As Integer
Dim cellA As Variant
Dim cellB As Variant
Dim cellCnt As Integer
Dim lookupRange As Range
Dim lookinRange As Range

lrOne = Sheet1.Cells(Rows.Count, 5).End(xlUp).Row
lrTwo = Sheet3.Cells(Rows.Count, 1).End(xlUp).Row
lcOne = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
lcTwo = Sheet3.Cells(1, Columns.Count).End(xlToLeft).Column

Set lookupRange = Sheet1.Range(Cells(1,5), Cells(lrOne, lcOne))
Set lookinRange = Sheet3.Range(Cells(1,1), Cells(lrTwo, lcTwo))

For Each cellA In lookupRange
    For Each cellB in lookinRange
        If cellA.Value = cellB.Value And cellA.Value <> "" Then
            cellB.Interior.ColorIndex = 3
            cellCnt = cellCnt + 1
        End If
    Next cellB
Next cellA