Excel,比较两个表中的两个特定行并突出显示差异

时间:2015-04-17 12:39:34

标签: excel vba excel-vba

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

嗨,这是我第一次上S.O,请放心,我花了几个小时寻找解决方案。我有一个状态列,显示状态,如删除,新,更改。 当状态为"更改"时,我想将列E中的特定行与Sheet3中Excel(XFD)中的最后一个可能列到列A中的最后一个可能列(XFD)进行比较。 Sheet1并突出显示不同的单元格。

我找到了这个解决方案: -

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

但是,这会对列进行比较,我不知道如何将sheet1中的E-XFD列与sheet2中的A-XFD列进行比较。

此工作簿中还有几个工作表,但我只想比较sheet1和sheet2。

如果你们能帮助我,我们将不胜感激:)

谢谢!

1 个答案:

答案 0 :(得分: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