我要检查两张纸,以确保一列与另一张纸上的另一列具有相同的值。
在一张纸上,值与同一列上的名称隔行扫描。虽然在另一张纸上,这些值本身就是一列。
Sheet1 Sheet2
Column1 Column 2
Column1 Name1 rate1
Name1 Name2 rate2
rate1 Name3 rate3
Name2
rate2
Name3
rate3
我希望Excel能够查看rate1
中的Sheet1
并查看它是否与rate1
中的Sheet2
匹配,如果存在差异,请突出显示红色的单元格在Sheet2
。如果Sheet1
中的费率是" N / A",请不要管它,不要突出显示红色。
我在阅读正确的单元格并让它跳过Sheet1
中的名称时遇到了问题。
这是我的代码:(它很乱......)
Sub ratetest()
Dim calc As Double
Dim rate As Double
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")
Dim a As Integer
Dim b As Integer
'rate = ThisWorkbook.Sheets("Sheet1").Cells(a, 9)
'calc = ThisWorkbook.Sheets("Sheet2").Cells(b, 4)
a = 13
b = 2
For a = 13 To ws1.Range("I45").End(xlUp).Row Step 2
For b = 2 To ws1.Range("D17").End(xlUp).Row
If ws1.Cells(a, 9) <> ws2.Cells(b, 4) Or ws1.Cells(a, 9) <> "N/A" Then
' do nothing...
Else
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next b
Next a
End Sub
答案 0 :(得分:0)
这将以红色突出显示在Sheet1-Col I上找不到Sheet2-Col D上的所有单元格:
Option Explicit
Public Sub RateTest1()
Const COLUMN_1 = "I", WS1_START = 12
Const COLUMN_2 = "D", WS2_START = 2
Dim ws1 As Worksheet, ws2 As Worksheet, col1 As Variant, col2 As Variant, tr As Long
Dim max1 As Long, max2 As Long, r1 As Long, r2 As Long, red As Long, found As Boolean
Dim miss As Range
tr = Rows.Count: red = RGB(255, 0, 0)
Set ws1 = ThisWorkbook.Sheets("Sheet1"): max1 = ws1.Cells(tr, COLUMN_1).End(xlUp).Row
Set ws2 = ThisWorkbook.Sheets("Sheet2"): max2 = ws2.Cells(tr, COLUMN_2).End(xlUp).Row
col1 = ws1.Range(ws1.Cells(1, COLUMN_1), ws1.Cells(max1, COLUMN_1))
col2 = ws2.Range(ws2.Cells(1, COLUMN_2), ws2.Cells(max2, COLUMN_2))
For r2 = WS2_START To max2 'check each value on sheet 2, col D
For r1 = WS1_START To max1 Step 2 'check every 2nd value on sheet 1, col I
If Len(col1(r1, 1)) > 0 And col1(r1, 1) <> "N/A" Then 'cell.sheet1 not empty
found = (col1(r1, 1) = col2(r2, 1)) 'if c.sheet1 = c.sheet2 -> is found
If found Then Exit For
End If
Next
If Not found Then
If miss Is Nothing Then
Set miss = ws2.Cells(r2, COLUMN_2)
Else
Set miss = Union(miss, ws2.Cells(r2, COLUMN_2))
End If
End If
Next
miss.Interior.Color = red
End Sub