比较两张表中的值,突出显示相似性,运行但不起作用

好吧,我正在做一个银行注册,我有一个工作表(“存款和贷款”),我正在比较一个内部创build的报告(“六月PB INS”)的银行对帐单。

对于银行对账单中的每个项目,我在内部报表中search具有匹配date(第1列)的行,包含公司描述符(string1),并与金额(银行对帐单第2列中的第3列内部报告第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 

如果你用长的sheet.cell.value引用replacevariables,你会发现你的错误(并且看到你做了无关的比较)

 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 

我们真的不需要search同一个string两次相同的值: InStr(1, Sheets("June PB INS").Cells(iPBINS, 3).Value, string1, 1) > 0我们也没有需要检查date是否匹配多次:`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 

回到你的标准并修复ANDOR

  '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返回干草堆中针的起始位置,如果没有find,则返回0。 因此, Instr("abcde","c",1)回复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语句只需将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


我宁愿缩短variables名称。 喜欢这个:

 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 

这是我结束了的代码,决定沟渠比赛string部分

 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