2 Spalten in 2 Tabellen vergleichen/Zeile kopieren

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: 2 Spalten in 2 Tabellen vergleichen/Zeile kopieren
von: Willi Wacker
Geschrieben am: 18.10.2015 07:34:52

Hallo,
in diesem Fall muß ich wirklich sagen: ich hoffe es erbarmt sich einer meiner. Seit Tagen versuche ich 2 Spalten in 2 verschiedenen Tabellen miteinander zu vergleichen (ich habe bereits mehrere Ansätze versucht).
Ist der Inhalt(Text) in der Zelle(x) aus Tabelle1 gleich dem Inhalt der Zelle(y) aus Tabelle 2, soll in Tabelle 2 diese ZEILE!! gelöscht werden (es darf aber keine Leerzeile bestehen bleiben) und die ZEILE!! aus Tabelle1 ans Ende von Tabelle2 kopiert werden. Findet sich keine Übereinstimmung, so soll die Zeile (Tabelle1) ans Ende von Tabelle2 kopiert werden.
Derzeit bin ich wieder bei zeitaufwendigen Für Schleifen (Sorry, aber ich weiß mir einfach nicht mehr zu helfen):
Weitere Infos:
Tabelle j_Endergebnis ist immer kleiner als Endergebnis
Tabelle Endergebnis umfaßt bis zu 10000 Zeilen
Aus j_Endergebnis soll jede Zelle aus der Spalte F(6) mit jeder Zelle aus der Tabelle Endergebnis Spalte F(6) verglichen werden


Sub Vergleich()
Dim JE1, E1 As Long                      ' hier fehlen einige DIM's ich weiß
    Set wksE = Worksheets("Endergebnis")
    Set wksJE = Worksheets("j_Endergebnis")
    
    x1 = Sheets("j_Endergebnis").UsedRange.SpecialCells(xlCellTypeLastCell).Row
    y1 = Sheets("Endergebnis").UsedRange.SpecialCells(xlCellTypeLastCell).Row
    
    With wksJE
        For lngZaehler = 2 To x1
          For x = 2 To y1
            If wksJE.Cells(lngZaehler, 6) = wksE.Cells(x, 6) Then
' Wenn eine Übereinstimmung gefunden
                MsgBox "Zeile löschen in Tab Endergebnis"
                MsgBox "Zeile aus Tab j_Endergebnis ans Ende oder aber auch in diese gelöschte   _
_
Zeile schreiben (das ist egal)"
            Else
' Wenn keine Übereinstimmung besteht                
                MsgBox "Zeile aus Tab j_Endergebnis ans Ende von TAb Endergebnid schreiben"
                 y1 = y1 + 1
                 wksJE.Rows(lngZaehler).Copy Destination:=wksE.Range("A" & y1)
            End If
            x = x + 1
      Next x
      lngZaehler = lngZaehler + 1
Next lngZaehler
End With

Noch eins: laßt Gnade walten ;) der ein oder andere kennt das sicher, wenn er etwas erreichen will und sich ständig verläuft und es will einfach nicht funktionieren. Ich weiß, der Code ist kein Ruhmesblatt, aber derzeit herrscht bei mir Flaute.
Danke allen Rettern im Voraus.
Willi

Bild

Betrifft: AW: 2 Spalten in 2 Tabellen vergleichen/Zeile kopieren
von: hary
Geschrieben am: 18.10.2015 08:51:42
Moin
Eine Schleife kannst du dir Sparen.

Dim zelle As Range
'--statt zweiter Schleife
Set zelle = wksE.Columns(6).Find(What:=wksJE.Cells(lngZaehler, 6), LookIn:=xlValues, lookat:= _
xlWhole)
  If Not zelle Is Nothing Then
  'wenn gefunden
  Else
  'wenn nicht gefunden
  End If
Set zelle = Nothing

gruss hary

Bild

Betrifft: AW: 2 Spalten in 2 Tabellen vergleichen/Zeile kopieren
von: Willi Wacker
Geschrieben am: 18.10.2015 09:54:25
Hallo Hary,
das ist ja super! Bleibt noch eine Frage:
woher weiß ich, in welcher Zeile - im Falle das in beiden Tabellen ein Inhalt vorhanden ist - ich mich befinde?


Sub Vergleich()
Dim JE1, E1 As Long
Dim zelle As Range
    Set wksE = Worksheets("Endergebnis")
    Set wksJE = Worksheets("j_Endergebnis")
    
    x1 = Sheets("j_Endergebnis").UsedRange.SpecialCells(xlCellTypeLastCell).Row
    y1 = Sheets("Endergebnis").UsedRange.SpecialCells(xlCellTypeLastCell).Row
    With wksJE
        For lngZaehler = 2 To x1
            Set zelle = wksE.Columns(6).Find(What:=wksJE.Cells(lngZaehler, 6), LookIn:=xlValues, _
 lookat:=xlWhole)
                If Not zelle Is Nothing Then
                    MsgBox "wenn gefunden"
                    y1 = y1 + 1
' hier muß ich nun in Tabelle2 also wksE die entsprechende Zeile löschen  <-----???????
' dazu fehlt mir aber die Zeilennummer
' nicht nur den Inhalt der Zeile, sondern die ganze Zeile löschen
' das führt zu y1 = y1 - 1 um dann ans Ende die in Tabelle1 gefundene 
' Zeile ans Ende dran zu hängen 
'                    wksE.Rows(?????????).Delete        <--- in etwa so?
                Else
                    MsgBox "wenn nicht gefunden"
                    y1 = y1 + 1
                    wksJE.Rows(lngZaehler).Copy Destination:=wksE.Range("A" & y1)
                End If
            Set zelle = Nothing
        Next lngZaehler
    End With
End Sub
Danke imm Voraus.
Willi

Bild

Betrifft: AW: 2 Spalten in 2 Tabellen vergleichen/Zeile kopieren
von: Willi Wacker
Geschrieben am: 18.10.2015 12:31:52
Hallo Hary,
das ist ja super! Bleibt noch eine Frage:
woher weiß ich, in welcher Zeile - im Falle das in beiden Tabellen ein Inhalt vorhanden ist - ich mich befinde?


Sub Vergleich()
Dim JE1, E1 As Long
Dim zelle As Range
    Set wksE = Worksheets("Endergebnis")
    Set wksJE = Worksheets("j_Endergebnis")
    
    x1 = Sheets("j_Endergebnis").UsedRange.SpecialCells(xlCellTypeLastCell).Row
    y1 = Sheets("Endergebnis").UsedRange.SpecialCells(xlCellTypeLastCell).Row
    With wksJE
        For lngZaehler = 2 To x1
            Set zelle = wksE.Columns(6).Find(What:=wksJE.Cells(lngZaehler, 6), LookIn:=xlValues, _
 _
 lookat:=xlWhole)
                If Not zelle Is Nothing Then
                    MsgBox "wenn gefunden"
                    y1 = y1 + 1
' hier muß ich nun in Tabelle2 also wksE die entsprechende Zeile löschen  <-----???????
' dazu fehlt mir aber die Zeilennummer
' nicht nur den Inhalt der Zeile, sondern die ganze Zeile löschen
' das führt zu y1 = y1 - 1 um dann ans Ende die in Tabelle1 gefundene 
' Zeile ans Ende dran zu hängen 
'                    wksE.Rows(?????????).Delete        <--- in etwa so?
                Else
                    MsgBox "wenn nicht gefunden"
                    y1 = y1 + 1
                    wksJE.Rows(lngZaehler).Copy Destination:=wksE.Range("A" & y1)
                End If
            Set zelle = Nothing
        Next lngZaehler
    End With
End Sub
Danke im Voraus.
Willi

Bild

Betrifft: AW: 2 Spalten in 2 Tabellen vergleichen/Zeile kopieren
von: hary
Geschrieben am: 18.10.2015 13:22:57
Moin Willi
Sollte passen:

Sub Vergleich()
Dim x1 As Long, Y1 As Long
Dim zelle As Range
Dim wksE As Worksheet, wksJE As Worksheet
Set wksE = Worksheets("Endergebnis")
Set wksJE = Worksheets("j_Endergebnis")
With wksJE
  x1 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
      For lngZaehler = 2 To x1
        Set zelle = wksE.Columns(6).Find(What:=.Cells(lngZaehler, 6), LookIn:=xlValues, lookat:= _
xlWhole)
          If Not zelle Is Nothing Then
             '--- MsgBox "wenn gefunden"
              wksE.Rows(zelle.Row).Delete
          Else
             '--- MsgBox "wenn nicht gefunden"
              Y1 = wksE.UsedRange.SpecialCells(xlCellTypeLastCell).Row
              .Rows(lngZaehler).Copy Destination:=wksE.Range("A" & Y1)
          End If
            Set zelle = Nothing
      Next lngZaehler
End With
End Sub

gruss hary

Bild

Betrifft: AW: Tip
von: hary
Geschrieben am: 18.10.2015 13:35:24
Moin nochemal

wksE.UsedRange

UsedRange kann aber in die Hose gehen, da Excel sich die ganze Zeit merkt wie gross der Bereich war.
Besser evtl. die letzte benutze Zelle gemaess einer immer belegten Spalte zu ermitteln.
Bsp.-weise hier in SpalteA
wksE.Cells(Rows.Count,1).end(xlup).Row

gruss hary

Bild

Betrifft: AW: 2 Spalten in 2 Tabellen vergleichen/Zeile kopieren
von: Willi Wacker
Geschrieben am: 18.10.2015 16:17:23
Hallo Hary,
super, das war's.
Hoffe auch mal in Deine Shären zu kommen.
Nochmals Danke.
Willi

 Bild

Beiträge aus den Excel-Beispielen zum Thema "2 Spalten in 2 Tabellen vergleichen/Zeile kopieren"