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

好的，我正在做一个银行记录，我有一个工作表（“存款和信贷”），银行对账单，我将其与一个内部创建的报告（“6月的PB INS”）进行比较

对于银行对账单中的每个项目，我在内部报告中搜索具有匹配日期（第1列）、包含公司描述符（string1）和匹配金额（银行对账单中的第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

选项比较文本
亚高亮匹配（）
调暗Sht1LastRow的长度，Sht2LastRow的长度
最后一排一样长
将iPBINS变暗为长，iPBINS计算为长，Idepositions计算为长，Idepositions计算为长
作为变体的Dim string1
Sht1LastRow=表格（“存款和信用”）。单元格（10000，1）。结束（xlUp）。行
Sht2LastRow=板材（“六月铅英寸”）.单元（100000，1）.结束（xlUp）.行
iPBINS=2
iDeposits=2
对于Idepositions=2至Sht1LastRow
string1=表（“存款和信用”）。单元格（Idepositis，7）。值
对于iPBINS=2至Sht2LastRow
If Sheets（“存款和信用”）.Cells（Idepositis，1）。Value=Sheets（“June PB-INS”）.Cells（iPBINS，1）。Value和InStr（1，Sheets（“June PB-INS”）.Cells（iPBINS，3）。Value，string1，1）0和Sheets（“存款和信用”）.Cells（Idepositis，3）=Sheets（“June PB-INS”）.Cells（iPBINS，2）或Sheets（“存款和信用”）.Cells（Idepositis，1）。Value=Sheets(“六月PB INS”）。单元格（iPBINS，1）。数值和仪表（1，表（“六月PB INS”）。单元格（iPBINS，3）。数值，字符串1，1）0和表（“存款和信用”）。单元格（Idepositis，3）=表（“六月PB INS”）。单元格（iPBINS，15）然后
表格（“存款和信用”）。单元格（Idepositis，12）。值=表格（“Idepositis”）。单元格（iPBINS，1）。地址（1，1，1，1）和表格（“存款和信用”）。行（“Idepositis:Idepositis”）。选择
有选择。内饰
.Pattern=xlSolid
.PatternColorIndex=xlAutomatic
.Color=5296274
.TintAndShade=0
.PatternTintAndShade=0
以
如果结束
下一个iPBINS
下一个设想
端接头

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

我们真的不需要在同一字符串中搜索两次相同的值：

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

返回您的标准并修复

和

s和

或

s：

    '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）

retruns

3

。将其用作逻辑运算符时，您只需检查该值是否大于0。

添加括号将使您的

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

语句分成两个语句，以使其更具可读性

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

---

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

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

---

您有多少条记录？超过10000条，您查找最后一行的方法将失败（意味着您永远不会进入循环）。请选择

单元格（Rows.Count，1）。结束（xlUp）.Row

Sht1LastRow和Sht2LastRow都获得了正确的值，即带有工作表最后一个条目的行号。内部报表有70k条记录，当在调试模式下悬停Sht2LastRow时，显示最后一行的正确编号。很好的细分+1。我喜欢使用变量使

If

语句更可读的方式。您错过了

行（“iDeposits:iDeposits”）

。

指令（）0

是一种常见的做法。我确信这里没有什么区别，但我在某个地方读到，

的计算速度比使用

更快。我喜欢描述性变量名。它使我从现在起5个月后阅读意大利面代码变得更容易。：）关于

与

的有趣说明。我尝试用loopi测试它通过5000万个元素的随机字符数组，但是现在

没有提供足够的粒度，50亿我的电脑崩溃了。并不是说纳米级的效率是VBA开发人员追求的主要功能…我想在If…Then之后提到连接问题，但我的老板认为我有时应该做真正的工作。哈哈…老板真的很碍事。我希望我知道我在哪里读到了
与
的对比。你可以用
定时器来测量毫秒。基本模式是
暗启动：启动=定时器：'做点什么：调试。打印“执行时间：”；定时器-启动
，非常感谢。我把它用作模板，然后使用了Tim的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

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

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