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

Posted 2023-03-06

技术标签:

【中文标题】比较两张纸上的值，突出显示相似之处，运行但不起作用【英文标题】：Compare values across two sheets, highlight similarities, Runs but doesnt work 【发布时间】：2016-12-31 19:46:12 【问题描述】：

好的，所以我正在做银行记录，我有一个工作表（“存款和贷方”），即银行对账单，我将其与内部创建的报告（“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

【问题讨论】：

你有多少条记录？超过 10000 并且您查找最后一行的方法将失败（意味着您永远不会进入循环）。喜欢Cells(Rows.Count, 1).End(xlUp).Row Sht1LastRow 和 Sht2LastRow 都获得正确的值，即工作表最后一个条目的行号。内部报告有 70k 条记录，当在调试模式下悬停在 Sht2LastRow 上时，会显示最后一行的正确编号。 【参考方案1】：

如果你用变量代替长 sheet.cell.value 引用，你会发现你的错误（并看到你在进行无关的比较）

Dim TransDate As String
Dim TransAmt As Long
Dim PBINSDate As String
Dim PBINSAmt As Long

TransDate = Sheets("Deposits And Credits").Cells(iDeposits, 1).Value
PBINSDate = Sheets("June PB INS").Cells(iPBINS, 1).Value
TransAmt = Sheets("Deposits And Credits").Cells(iDeposits, 3).Value

    If TransDate = PBINSDate _
    And InStr(1, Sheets("June PB INS").Cells(iPBINS, 3).Value, string1, 1) > 0 _
    And TransAmt = Sheets("June PB INS").Cells(iPBINS, 2) _
    Or TransDate = PBINSDate _
    And InStr(1, Sheets("June PB INS").Cells(iPBINS, 3).Value, string1, 1) > 0 _
    And TransAmt = 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

我们真的不需要为相同的值搜索相同的字符串两次：InStr(1, Sheets("June PB INS").Cells(iPBINS, 3).Value, string1, 1) > 0 我们也不需要检查日期是否匹配多次：`TransDate = PBINSDate' 让我们摆脱额外的看看它长什么样。

    If TransDate = PBINSDate _ 
    And InStr(1, Sheets("June PB INS").Cells(iPBINS, 3).Value, string1, 1) > 0 _
    And TransAmt = Sheets("June PB INS").Cells(iPBINS, 2) _
    And TransAmt = Sheets("June PB INS").Cells(iPBINS, 15) _
    Then

回到您的标准并修复ANDs 和ORs：

    'The Dates must match
    If TransDate = PBINSDate _
    'The descriptor must be found in the statement line item
    And InStr(1, Sheets("June PB INS").Cells(iPBINS, 3).Value, string1, 1) > 0 _
    'The statement amount should match either column 2 OR column 15
    And (TransAmt = Sheets("June PB INS").Cells(iPBINS, 2) _
         Or _
         TransAmt = Sheets("June PB INS").Cells(iPBINS, 15) _
    ) _
    Then

我要指出的另一个问题：

InStr 返回大海捞针中针的起始位置，如果未找到，则返回 0。因此，Instr("abcde","c",1) 会返回 3。使用 this 作为逻辑运算符时，只需要检查值是否大于 0 即可。

【讨论】：

不错的细分+1。我喜欢你如何使用变量使Ifstatement 更具可读性。你错过了Rows("iDeposits:iDeposits")。 Instr() <> 0 是常见的做法。我确信这里没有任何区别，但我在某处读到 <> 的计算速度比使用 > 更快。我喜欢描述性的变量名称。从现在起 5 个月后，它使阅读我的意大利面条代码变得更加容易。 :) 关于> 与<> 的有趣说明。我试图通过循环遍历 5000 万个随机字符元素数组来测试它，但 Now 没有提供足够的粒度，并且 50 亿个元素使我的 PC 崩溃。并不是说纳米级效率是 VBA 开发人员寻求的主要功能……我的意思是在 If...Then 之后提到串联问题，但我的老板认为我有时应该做一些真正的工作。大声笑..老板真的妨碍了。我希望我知道我在哪里读到了 <> 和 >。您可以使用Timer 来测量毫秒。基本模式是Dim Start : Start = Timer : 'Do Something : Debug.Print "Execution Time:"; Timer - Start【参考方案2】：

添加括号将使您的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

【讨论】：

非常感谢。我用这个作为模板，然后使用了 Tim 的 If 语句。【参考方案3】：

这是我最终得到的代码，决定放弃匹配字符串部分

Sub StackCombined()

Dim TransDate As String
Dim TransAmt As Long
Dim PBINSDate As String
Dim PBINSAmt As Long

Dim wsPB As Worksheet
Dim Sht1LastRow As Long, Sht2LastRow As Long
Dim x2 As Long, x2count As Long, x1 As Long, x1count As Long
' Sht1LastRow finds the last row of Deposits and Credits with a value
Sht1LastRow = Sheets("Deposits And Credits").Cells(10000, 1).End(xlUp).Row
' Sht2LastRow finds the last row of June PB INS with a value
Sht2LastRow = Sheets("June PB INS").Cells(100000, 1).End(xlUp).Row

' Call worksheet June PB INS just wsPB
Set wsPB = Sheets("June PB INS")
With Sheets("Deposits And Credits")

    For x1 = 2 To Sht1LastRow

        For x2 = 2 To Sht2LastRow
            'TransDate is the transaction date recorded from the bank
            TransDate = Sheets("Deposits And Credits").Cells(x1, 1).Value
            'PBINSDate is the transaction date recorded internally through EPIC
            PBINSDate = Sheets("June PB INS").Cells(x2, 1).Value
            'TransAmt is the bank statements amount of the transaction
            TransAmt = Sheets("Deposits And Credits").Cells(x1, 3).Value

                'The Dates must match
                'The amount must either column 2, single record, OR column 15, daily record
                'if these two conditions are met, highlight the bank statement and record where the match was found
                If TransDate = PBINSDate _
                And (TransAmt = Sheets("June PB INS").Cells(x2, 2) _
                    Or _
                    TransAmt = Sheets("June PB INS").Cells(x2, 15) _
                ) _
                Then
                    .Cells(x1, 12).Value = wsPB.Cells(x2, 1).Address(True, True, xlA1, True) And Sheets("Deposits And Credits").Rows(x1 & ":" & x1).Select
                       With Selection.Interior
                          .Pattern = xlSolid
                          .PatternColorIndex = xlAutomatic
                          .Color = 5296274
                          .TintAndShade = 0
                          .PatternTintAndShade = 0
                      End With
               End If
        Next x2
    Next x1
End With
End Sub

【讨论】：

以上是关于比较两张纸上的值，突出显示相似之处，运行但不起作用的主要内容，如果未能解决你的问题，请参考以下文章

如何在开放式办公室比较两张纸并用颜色标记不同的值

宏复制到另一张纸上的下一个空白行