Vergleichen Sie Werte über zwei Blätter, markieren Sie Ähnlichkeiten, Läuft aber funktioniert nicht

Question

OK, also mache ich eine Bankrec, ich habe ein Arbeitsblatt ("Einlagen und Kredite"), den Kontoauszug, den ich mit einem intern erstellten Bericht vergleiche ("Juni PB INS").

Für jede Position im Kontoauszug suche ich im internen Bericht nach einer Zeile mit übereinstimmendem Datum (Spalte 1), enthält den Unternehmensdeskriptor (string1) und stimmt mit dem Betrag überein (Spalte 3 im Kontoauszug) Spalte 2 ODER Spalte 15 im internen Bericht).

Wenn es eine Übereinstimmung gibt, möchte ich die Zeile im Kontoauszug-Arbeitsblatt markieren und in Spalte 7 die Adresse der übereinstimmenden internen Berichtszeile markieren.

Der Code hat scheinbar keine Fehler, macht aber keine der Änderungen.

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

Wenn Sie Variablen für die langen sheet.cell.value Referenzen ersetzen, können Sie Ihre Fehler finden (und sehen, dass Sie Fremd Vergleiche machen)

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 

Wir brauchen nicht wirklich Um die gleiche Zeichenfolge für den gleichen Wert zweimal zu suchen: InStr(1, Sheets("June PB INS").Cells(iPBINS, 3).Value, string1, 1) > 0 Wir müssen auch nicht überprüfen, ob die Daten mehr als einmal übereinstimmen: `TransDate = PBINSDate 'Lassen Sie uns die Extras loswerden und sehen, wie es aussieht.

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 

Gehen wir zurück zu Ihren Kriterien und zur Festlegung der AND s und OR 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 

ein weiteres Problem, ich darauf hinweisen, werde:

InStr gibt die Startposition der Nadel in der Heuhaufen oder 0, wenn es nicht gefunden wird. So, Instr("abcde","c",1) retruns 3. Wenn Sie dies als logischen Operator verwenden, müssen Sie nur prüfen, ob der Wert größer als 0 ist.

Answer 2

Durch das Hinzufügen von Klammern wird Ihre If-Anweisung funktionieren.

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 

Es besteht keine Notwendigkeit, die Bedingungen der If Aussage gerade Gruppe die Or Bedingungen zusammen und schließen Sie sie in Klammern zu wiederholen.

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 

Ich würde es vorziehen, die If Anweisung in zwei Anweisungen brechen sie besser lesbar zu machen.

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 

Sie nicht Zeilen Code wie folgt verketten sollten:

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

Falsch:

Sheets("Deposits And Credits").Rows("iDeposits:iDeposits").Select

Richtig:

Sheets("Deposits And Credits").Rows(iDeposits & ":" & iDeposits").Select

---

Ich würde es vorziehen, die Variablennamen zu verkürzen. Wie folgt aus:

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 

Answer 3

Hier ist der Code I mit endete, das Match Seilabschnitt zu Graben Entschied

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