比较两张纸上的值，突出相似性，运行但不起作用
Compare values across two sheets, highlight similarities, Runs but doesnt work
好的，我正在做一份银行记录，我有一张工作表 ("Deposits and Credits")，银行对帐单，我正在将其与内部创建的报告 ("June PB INS") 进行比较。
对于银行对帐单中的每个项目，我在内部报告中搜索具有匹配日期（第 1 列）、包含公司描述符（string1）并匹配金额（银行中的第 3 列）的行声明，内部报告中的第 2 栏或第 15 栏）。
如果有匹配项，我想突出显示银行对帐单工作表中的行，并在第 7 列中标记匹配的内部报告行的地址。
Code貌似没有任何瑕疵，但并没有做任何改动。
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 引用，您会发现错误（并发现您正在进行无关的比较）
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 returns 大海捞针的起始位置，如果找不到则为 0。因此，Instr("abcde","c",1) 重新运行 3。将this作为逻辑运算符使用时，只需要检查其值是否大于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
我希望缩短变量名。像这样：
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
好的，我正在做一份银行记录，我有一张工作表 ("Deposits and Credits")，银行对帐单，我正在将其与内部创建的报告 ("June PB INS") 进行比较。
对于银行对帐单中的每个项目，我在内部报告中搜索具有匹配日期（第 1 列）、包含公司描述符（string1）并匹配金额（银行中的第 3 列）的行声明，内部报告中的第 2 栏或第 15 栏）。
如果有匹配项，我想突出显示银行对帐单工作表中的行，并在第 7 列中标记匹配的内部报告行的地址。
Code貌似没有任何瑕疵，但并没有做任何改动。
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 引用，您会发现错误（并发现您正在进行无关的比较）
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 returns 大海捞针的起始位置，如果找不到则为 0。因此，Instr("abcde","c",1) 重新运行 3。将this作为逻辑运算符使用时，只需要检查其值是否大于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
我希望缩短变量名。像这样：
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