vba - 比较两张纸上的值，突出显示相似之处，运行但不起作用

Question

好的，所以我正在做银行记录，我有一个工作表(“存款和贷方”)，即银行对账单，我将其与内部创建的报告(“June PB INS”)进行比较。

对于银行对账单中的每个项目，我在内部报告中搜索具有匹配日期(第 1 列)、包含公司描述符(字符串 1)并匹配金额(银行对账单第 3 列，第 2 列)的行内部报告第 15 栏)。

如果有匹配项，我想突出显示银行对帐单工作表中的行，并且我想在第 7 列中标记匹配的内部报告行的地址。

该代码看似没有缺陷，但没有进行任何更改。

Option Compare Text

Sub HighlightMatches()
Dim Sht1LastRow As Long, Sht2LastRow As Long
Dim lastrow As Long
Dim iPBINS As Long, iPBINScount As Long, iDeposits As Long, iDepositscount As Long
Dim string1 As Variant

Sht1LastRow = Sheets("Deposits And Credits").Cells(10000, 1).End(xlUp).Row
Sht2LastRow = Sheets("June PB INS").Cells(100000, 1).End(xlUp).Row
iPBINS = 2
iDeposits = 2

For iDeposits = 2 To Sht1LastRow
string1 = Sheets("Deposits And Credits").Cells(iDeposits, 7).Value
    For iPBINS = 2 To Sht2LastRow
        If Sheets("Deposits And Credits").Cells(iDeposits, 1).Value = Sheets("June PB INS").Cells(iPBINS, 1).Value And InStr(1, Sheets("June PB INS").Cells(iPBINS, 3).Value, string1, 1) <> 0 And Sheets("Deposits And Credits").Cells(iDeposits, 3) = Sheets("June PB INS").Cells(iPBINS, 2) Or Sheets("Deposits And Credits").Cells(iDeposits, 1).Value = Sheets("June PB INS").Cells(iPBINS, 1).Value And InStr(1, Sheets("June PB INS").Cells(iPBINS, 3).Value, string1, 1) <> 0 And Sheets("Deposits And Credits").Cells(iDeposits, 3) = Sheets("June PB INS").Cells(iPBINS, 15) Then
            Sheets("Deposits And Credits").Cells(iDeposits, 12).Value = Sheets("June PB INS").Cells(iPBINS, 1).Address(1, 1, 1, 1) And Sheets("Deposits And Credits").Rows("iDeposits:iDeposits").Select
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 5296274
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
        End If
    Next iPBINS
Next iDeposits

End Sub

Answer 1

添加括号将使您的If声明工作。

If (Sheets("Deposits And Credits").Cells(iDeposits, 1).Value = Sheets("June PB INS").Cells(iPBINS, 1).Value And InStr(1, Sheets("June PB INS").Cells(iPBINS, 3).Value, string1, 1) <> 0 And Sheets("Deposits And Credits").Cells(iDeposits, 3) = Sheets("June PB INS").Cells(iPBINS, 2)) Or (Sheets("Deposits And Credits").Cells(iDeposits, 1).Value = Sheets("June PB INS").Cells(iPBINS, 1).Value And InStr(1, Sheets("June PB INS").Cells(iPBINS, 3).Value, string1, 1) <> 0 And Sheets("Deposits And Credits").Cells(iDeposits, 3) = Sheets("June PB INS").Cells(iPBINS, 15)) Then

End If

无需重复条件 If声明只是将 Or 分组条件放在一起并用括号括起来。

If Sheets("Deposits And Credits").Cells(iDeposits, 1).Value = Sheets("June PB INS").Cells(iPBINS, 1).Value And InStr(1, Sheets("June PB INS").Cells(iPBINS, 3).Value, string1, 1) <> 0 And (Sheets("Deposits And Credits").Cells(iDeposits, 3) = Sheets("June PB INS").Cells(iPBINS, 2) Or Sheets("Deposits And Credits").Cells(iDeposits, 3) = Sheets("June PB INS").Cells(iPBINS, 15)) Then

End If

我宁愿打破 If语句分成两个语句，使其更具可读性。

If Sheets("Deposits And Credits").Cells(iDeposits, 1).Value = Sheets("June PB INS").Cells(iPBINS, 1).Value And InStr(1, Sheets("June PB INS").Cells(iPBINS, 3).Value, string1, 1) <> 0 Then
    If Sheets("Deposits And Credits").Cells(iDeposits, 3) = Sheets("June PB INS").Cells(iPBINS, 2) Or Sheets("Deposits And Credits").Cells(iDeposits, 3) = Sheets("June PB INS").Cells(iPBINS, 15) Then

    End If
End If

您不应该像这样连接代码行:
Sheets("Deposits And Credits").Cells(iDeposits, 12).Value = Sheets("June PB INS").Cells(iPBINS, 1).Address(1, 1, 1, 1) And Sheets("Deposits And Credits").Rows("iDeposits:iDeposits").Select
不正确:
Sheets("Deposits And Credits").Rows("iDeposits:iDeposits").Select
正确的:
Sheets("Deposits And Credits").Rows(iDeposits & ":" & iDeposits").Select
我宁愿缩短变量名。像这样:

Sub HighlightMatches()
    Dim wsPB As Worksheet

    Dim lastrow As Long
    Dim x2 As Long, x2count As Long, x1 As Long, x1count As Long

    Set wsPB = Sheets("June PB INS")
    With Sheets("Deposits And Credits")

        For x1 = 2 To .Cells(Rows.Count, 1).End(xlUp).Row

            For x2 = 2 To wsPB.Cells(Rows.Count, 1).End(xlUp).Row
                If .Cells(x1, 1).Value = wsPB.Cells(x2, 1).Value And InStr(1, wsPB.Cells(x2, 3).Value, .Cells(x1, 7).Value, vbTextCompare) <> 0 Then

                    If .Cells(x1, 3) = wsPB.Cells(x2, 2) Or .Cells(x1, 3) = wsPB.Cells(x2, 15) Then

                        .Cells(x1, 12).Value = wsPB.Cells(x2, 1).Address(True, True, xlA1, True)
                        With .Rows(x1).Interior
                            .Pattern = xlSolid
                            .PatternColorIndex = xlAutomatic
                            .Color = 5296274
                            .TintAndShade = 0
                            .PatternTintAndShade = 0
                        End With

                    End If
                End If
            Next x2
        Next x1

    End With
End Sub