vba: Spalten vergleichen und nicht übereinstimmende Werte zurückgeben

Question

Ich bin neu hier und bei VBA. Meine Frage lautet:

Ich habe 3 Blätter (1, 2 und 3). Bei sheet 1 habe ich Spalte A (Bereich A2-Ende) mit Daten, die ich mit Spalte A (Bereich A2-Ende) und D (Bereich D2-Ende) auf sheet 2 vergleichen möchte. Wenn ein Wert in sheet 1 Spalte A nicht auf sheet 2 Spalte A und D gefunden wird, sollte er den mismatched Wert in Blatt 3 ab dem Bereich A2 auflisten. Hier

ist, was ich habe:

Sub Makro5() 

Dim lastRowE As Integer 
Dim lastRowF As Integer 
Dim lastRowM As Integer 
Dim foundTrue As Boolean 


Application.ScreenUpdating = False 

lastRowE = Sheets("1").Cells(Sheets("1").Rows.Count, "A2").End(xlUp).row 
lastRowE = Sheets("2").Cells(Sheets("2").Rows.Count, "A2").End(xlUp).row 
lastRowF = Sheets("2").Cells(Sheets("2").Rows.Count, "D2").End(xlUp).row 
lastRowM = Sheets("3").Cells(Sheets("3").Rows.Count, "A2").End(xlUp).row 


For i = 1 To lastRowE 
foundTrue = False 
For j = 1 To lastRowF 

    If Sheets("1").Cells(i, 1).value = Sheets("2").Cells(j, 1).value Then 
     foundTrue = True 
and 
    If Sheets("1").Cells(i, 1).value = Sheets("2").Cells(j, 4).value Then 
     foundTrue = True 

     Exit For 
    End If 

Next j 

If Not foundTrue Then 

    Sheets("3").Rows(i).Copy Destination:= _ 
    Sheets("3").Rows(lastRowM + 1) 
    lastRowM = lastRowM + 1 

End If 

Answer 1

Dieser liest col A und D aus Sheet2 in einem Wörterbuch

Dann sucht Werte in Spalte A von Tabelle1 im Wörterbuch

Nicht gefundene Elemente werden in Tabelle3 platziert bei Zelle, A2

---

Option Explicit 

Public Sub FindMissing() 
    Dim ws1 As Worksheet, colA1 As Variant, r As Long, d1 As Object, d2 As Object 
    Dim ws2 As Worksheet, colA2 As Variant, colD2 As Variant, ws3 As Worksheet 

    Set d1 = CreateObject("Scripting.Dictionary") 
    Set d2 = CreateObject("Scripting.Dictionary") 

    Set ws1 = ThisWorkbook.Worksheets("Sheet1") 
    Set ws2 = ThisWorkbook.Worksheets("Sheet2") 
    Set ws3 = ThisWorkbook.Worksheets("Sheet3") 

    colA1 = ws1.Range("A2:A" & ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row) 'Sheet1.colA 
    colA2 = ws2.Range("A2:A" & ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row) 'Sheet2.colA 
    colD2 = ws2.Range("D2:D" & ws2.Cells(ws2.Rows.Count, 4).End(xlUp).Row) 'Sheet2.colD 

    If Not IsArray(colA1) Then MakeArray colA1 'Sheet1.colA contains only 1 row 
    If Not IsArray(colA2) Then MakeArray colA2 'Sheet2.colA contains only 1 row 
    If Not IsArray(colD2) Then MakeArray colD2 'Sheet2.colD contains only 1 row 

    For r = 1 To UBound(colA2) 
    d1(colA2(r, 1)) = vbNullString 'read Sheet2.ColA in dictionary d1.Keys 
    Next 
    For r = 1 To UBound(colD2) 
    d1(colD2(r, 1)) = vbNullString 'read Sheet2.ColD in dictionary d1.Keys 
    Next 

    For r = 1 To UBound(colA1)  'search vals from Sheet1.colA in dictionary d1 
    If Not d1.Exists(colA1(r, 1)) Then d2(colA1(r, 1)) = vbNullString 
    Next 

    ws3.Columns(1).Delete 
    If d2.Count > 0 Then ws3.Cells(2, 1).Resize(d2.Count, 1) = Application.Transpose(d2.Keys) 
End Sub 

---

Private Sub MakeArray(ByRef arr As Variant) 
    Dim tmp As Variant 
    tmp = arr 
    ReDim arr(1 To 1, 1 To 1) 
    arr(1, 1) = tmp 
End Sub 

Answer 2

Versuchen Sie diesen Code unter Verwendung von ...

Public Function Find_First(FindString As String, WithinRange As Range) As Boolean 

    Dim rng As Range 
    Find_First = False 
    If Trim(FindString) <> "" Then 
     With WithinRange 
      Set rng = .Find(What:=FindString, _ 
          After:=.Cells(.Cells.Count), _ 
          LookIn:=xlValues, _ 
          LookAt:=xlWhole, _ 
          SearchOrder:=xlByRows, _ 
          SearchDirection:=xlNext, _ 
          MatchCase:=False) 
      If Not rng Is Nothing Then 
       Find_First = True 
      End If 
     End With 
    End If 

End Function