我希望能够比较两个工作表,如果ws1上的列H和ws2上的列F中的日期存在差异,则突出显示ws2上的单元格。我遇到的麻烦是它们是从两个不同的单元开始的两个不同的列(比较ws1上的H9 +和ws2上的F10 +)这没有给我任何错误,但似乎没有任何事情发生。以下是我到目前为止的情况:
Sub matchMe()
Dim wS As Worksheet, wT As Worksheet
Dim r1 As Range, r2 As Range
Dim cel1 As Range, cel2 As Range
Set wS = ThisWorkbook.Worksheets("Project Status Report L3")
Set wT = ThisWorkbook.Worksheets("Demand Mapping - Active")
With wS
Set r1 = .Range("H9", .Cells(.Rows.Count, .Columns("R:R").Column).End(xlUp))
End With
With wT
Set r2 = .Range("F10", .Cells(.Rows.Count, .Columns("G:G").Column).End(xlUp))
End With
On Error Resume Next
For Each cel1 In r1
With Application
Set cel2 = .Index(r2, .Match(cel1.Value, r2, 0)) 'find match in sheet2
If Err = 0 Then
If cel1.Offset(, 8) <> cel2.Offset(, 8) Then cel2.Interior.ColorIndex = 1 'if difference, color
End If
Err.Clear
End With
Next cel1
End Sub
答案 0 :(得分:1)
我在网上找到了这段代码,它应该做你需要的。只需将shtBefore和shtAfter设置为工作表名称即可。
Sub compareSheets(shtBefore As String, shtAfter As String)
Dim mycell As Range
Dim mydiffs As Integer
For Each mycell In ActiveWorkbook.Worksheets(shtAfter).UsedRange
If Not mycell.Value = ActiveWorkbook.Worksheets(shtBefore).Cells(mycell.Row, mycell.Column).Value Then
mycell.Interior.Color = vbYellow
mydiffs = mydiffs + 1
End If
Next
MsgBox mydiffs & " differences found", vbInformation
ActiveWorkbook.Sheets(shtAfter).Select
End Sub
答案 1 :(得分:0)
Sub comparison()
For i = 2 To 1000
For j = 2 To 1000
If Worksheets(Worksheet).Range("A" & i).Value = Worksheets(Worksheet).Range("L" & j).Value Then
Worksheets(worksheet).Range("N" & j).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next j
Next i
End Sub