在评论说有类似的问题之前,我已经尝试了但不幸的是它们不起作用
嗨,这是我第一次上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。
如果你们能帮助我,我们将不胜感激:)
谢谢!
答案 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