Microsoft Excel

Herbers Excel/VBA-Archiv

VBA-Vergleich 2er Spalten in zwei Tabellenblättern


Betrifft: VBA-Vergleich 2er Spalten in zwei Tabellenblättern von: Christoph
Geschrieben am: 15.08.2018 16:33:34

Hallo liebe VBA Gemeinde,

ich hoffe das ihr mir weiterhelfen könnt, da ich bei einem Problem nicht weiterkomme.
Und zwar möchte ich aus zwei gleich aufgebauten Tabellenblätter 2 Spalten vergleichen, sind diese identisch so mach nichts, sind sie unterschiedlich so kopiere die Zeile aus dem Tabellenblatt 2 in das Tabellenblatt 1 an die letzte Position.

Als Beispiel:
- Tabellenblatt 1 Spalte B & C Abgleich Tabellenblatt 2 Spalte B & C
- Unterschiedliche Werte in der Zeile so kopiere die komplette Zeile A bis M aus dem Tabellenblatt 2 in das Tabellenblatt 1 unter der letzten befüllten Zeile.

Ich hatte hier schon einen Code im Forum gefunden, der mir 1 Spalte vergleicht, diesen möchte ich am liebsten erweitern, dass er zwei Abfragen macht. Finde leider nicht mehr den Forumseintrag aus dem ich diesen Code habe

Zur Erleichterung:

Sub Vergleich_FAUF_Marko()

 Dim zells As Range
 Dim x As Long
 Dim rng As Range
 Dim lastn As Long
 Dim lasta As Long
 Dim ws1 As Worksheet
 Dim ws2 As Worksheet
 Set ws1 = Worksheets("FAUF_dump")
 Set ws2 = Worksheets("FAUF")
 lastn = ws1.Cells(1048576, 2).End(xlUp).Row
 lasta = ws2.Cells(1048576, 2).End(xlUp).Row
 
 Set objDic = CreateObject("Scripting.Dictionary")
 Dim v, e
 With ws2.Range("B2:B" & lasta)
     v = .Value
 End With
       
     For Each e In v
         If Not objDic.Exists(e) Then objDic.Add e, e
    Debug.Print e
       Next
 
 
 Set rng = ws1.Range("B2:B" & lastn)
 
     With ws2.Cells.Interior
         .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
 End With
 
 
 For Each zells In rng
 lasta2 = ws2.Cells(1048576, 2).End(xlUp).Row
   If Not objDic.Exists(zells.Value) Then
   ws1.Range("A" & zells.Row & ":" & "N" & zells.Row).Copy ws2.Range("A" & lasta2 + 1)
   ws2.Range("A" & lasta2 + 1 & ":" & "N" & lasta2 + 1).Interior.Color = 5296274
   End If
        Next
 
 
 End Sub

Ich würde mich sehr über eine Hilfe von euch freuen ;) bis denn Christoph

  

Betrifft: AW: VBA-Vergleich 2er Spalten in zwei Tabellenblättern von: ChrisL
Geschrieben am: 15.08.2018 16:45:36

Hi

Hier eine mögliche Variante:

Sub t()
Dim lngZeile As Long
Dim WS1 As Worksheet: Set WS1 = Worksheets("Tabelle1")
Dim WS2 As Worksheet: Set WS2 = Worksheets("Tabelle2")

Application.ScreenUpdating = False
For lngZeile = 2 To WS2.Cells(Rows.Count, 2).End(xlUp).Row
    If WorksheetFunction.CountIfs(WS1.Columns(2), WS2.Cells(lngZeile, 2), _
        WS2.Columns(3), WS2.Cells(lngZeile, 3)) = 0 Then
        
        WS2.Rows(lngZeile).Copy WS1.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).EntireRow
        
    End If
Next lngZeile
End Sub
cu
Chris


  

Betrifft: AW: VBA-Vergleich 2er Spalten in zwei Tabellenblättern von: ChrisL
Geschrieben am: 15.08.2018 18:54:36

Mist, I did it again... Mini-Korrektur (einmal WS1 in WS2 geändert)

Sub t()
Dim lngZeile As Long
Dim WS1 As Worksheet: Set WS1 = Worksheets("Tabelle1")
Dim WS2 As Worksheet: Set WS2 = Worksheets("Tabelle2")

Application.ScreenUpdating = False
For lngZeile = 2 To WS2.Cells(Rows.Count, 2).End(xlUp).Row
    If WorksheetFunction.CountIfs(WS1.Columns(2), WS2.Cells(lngZeile, 2), _
        WS1.Columns(3), WS2.Cells(lngZeile, 3)) = 0 Then
        
        WS2.Rows(lngZeile).Copy WS1.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).EntireRow
        
    End If
Next lngZeile
End Sub



  

Betrifft: AW: VBA-Vergleich 2er Spalten in zwei Tabellenblättern von: Christoph
Geschrieben am: 16.08.2018 08:56:49

Moin Chris,

vielen Dank für deine schnelle Antwort. Es klappt soweit, ist ABER nicht ganz so schön ;)
Da ich in dem Tabellenblatt sehr große Daten drin habe, braucht Excel verdammt lange für den Vorgang.

Siehst du vielleicht die Möglichkeit meinen Code so umzubauen, dass er anstatt einer Spalte zwei Spalten vergleicht? Weil er performcensmäßig schneller ist ;)

Oder sieht irgendjemand anders noch eine andere "bessere" Lösung.

Besten DANK
Christoph


  

Betrifft: AW: VBA-Vergleich 2er Spalten in zwei Tabellenblättern von: Christoph
Geschrieben am: 16.08.2018 09:41:57

Also dein Code funktioniert doch nicht ganz so wie ich es mir erhoffe ;)
Wie eben schon beschrieben, wäre es cool wenn in meinen bestehenden Code die weiteren Abfragen implementiert werden könnten..

Wenn ich deinen Code ausführe, dann schreibt er beim ersten Mal das so rein wie ich es haben möchte, wenn ich dann erneut drauf klicke, erkennt er nicht, dass er die Daten schon einmal im Tabellenblatt 1 hat und kopiert alle Daten erneut herunter. Wenn ich ein drittes Mal draufklicke das gleiche...

Bitte um Hilfe


  

Betrifft: AW: VBA-Vergleich 2er Spalten in zwei Tabellenblättern von: ChrisL
Geschrieben am: 16.08.2018 09:49:09

Hi

Wenn ich deinen Code ausführe, dann schreibt er beim ersten Mal das so rein wie ich es haben möchte, wenn ich dann erneut drauf klicke, erkennt er nicht, dass er die Daten schon einmal im Tabellenblatt 1 hat und kopiert alle Daten erneut herunter.
Nicht rekonstruierbar.

Performance:
Eine Abfrage/Query, anstelle VBA, könnte helfen. Siehe dazu Stichwort "PowerQuery".

cu
Chris


  

Betrifft: AW: VBA-Vergleich 2er Spalten in zwei Tabellenblättern von: ChrisL
Geschrieben am: 16.08.2018 09:53:47

Hi

Falls du viele Formeln verwendest, könnte betr. Performance folgendes helfen:

Sub t()
Dim lngZeile As Long
Dim WS1 As Worksheet: Set WS1 = Worksheets("Tabelle1")
Dim WS2 As Worksheet: Set WS2 = Worksheets("Tabelle2")

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For lngZeile = 2 To WS2.Cells(Rows.Count, 2).End(xlUp).Row
    If WorksheetFunction.CountIfs(WS1.Columns(2), WS2.Cells(lngZeile, 2), _
        WS1.Columns(3), WS2.Cells(lngZeile, 3)) = 0 Then
        
        WS2.Rows(lngZeile).Copy WS1.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).EntireRow
        
    End If
Next lngZeile
Application.Calculation = xlCalculationAutomatic
End Sub
Ansonsten würde ich wie erwähnt eine Abfrage erstellen.

cu
Chris


  

Betrifft: AW: VBA-Vergleich 2er Spalten in zwei Tabellenblättern von: Christoph
Geschrieben am: 16.08.2018 09:58:39

Das Problem was noch da ist, dass er nicht erkennt, das die Zeilen schon in Tabelle 1 enthalten sind und ich somit beim zweiten Durchlauf doppelte Zeilen habe und beim dritten Durchlauf dreifache Zeilen.

Das rüberkopieren macht er so wie er soll. Nur die Erkennung ob die Daten schon enthalten sind macht er nicht..

Daran hakt es zurzeit.
Performence ist nicht so wichtig...;)

BG Christoph


  

Betrifft: AW: VBA-Vergleich 2er Spalten in zwei Tabellenblättern von: ChrisL
Geschrieben am: 16.08.2018 13:11:27

Hi Christoph

Deine Worte verstehe ich schon, aber wie erwähnt, ich kann es nicht rekonstruieren und einen Fehler den ich nicht habe/sehe kann ich auch nicht beheben.

cu
Chris


Beiträge aus dem Excel-Forum zum Thema "VBA-Vergleich 2er Spalten in zwei Tabellenblättern"