Excel VBA - 将隔行扫描列与非隔行扫描列进行比较

时间:2017-07-13 14:48:03

标签: excel vba excel-vba

我要检查两张纸,以确保一列与另一张纸上的另一列具有相同的值。

在一张纸上,值与同一列上的名称隔行扫描。虽然在另一张纸上,这些值本身就是一列。

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

1 个答案:

答案 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