2 Spalten in 2 Tabellen vergleichen/Zeile kopieren

Forumthread: 2 Spalten in 2 Tabellen vergleichen/Zeile kopieren

18.10.2015 07:34:52

Willi

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: 2 Spalten in 2 Tabellen vergleichen/Zeile kopieren

18.10.2015 08:51:42

hary

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

AW: 2 Spalten in 2 Tabellen vergleichen/Zeile kopieren

18.10.2015 09:54:25

Willi

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  
'                    wksE.Rows(?).Delete

Danke imm Voraus.
Willi

AW: 2 Spalten in 2 Tabellen vergleichen/Zeile kopieren

18.10.2015 12:31:52

Willi

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  
'                    wksE.Rows(?).Delete

Danke im Voraus.
Willi

AW: 2 Spalten in 2 Tabellen vergleichen/Zeile kopieren

18.10.2015 13:22:57

hary

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

AW: Tip

18.10.2015 13:35:24

hary

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

AW: 2 Spalten in 2 Tabellen vergleichen/Zeile kopieren

18.10.2015 16:17:23

Willi

Hallo Hary,
super, das war's.
Hoffe auch mal in Deine Shären zu kommen.
Nochmals Danke.
Willi

Beliebteste Forumthreads (12 Monate)

2 Spalten in 2 Tabellen vergleichen/Zeile kopieren

Forumthread: 2 Spalten in 2 Tabellen vergleichen/Zeile kopieren

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

2 Spalten in 2 Tabellen vergleichen/Zeile kopieren

Forumthread: 2 Spalten in 2 Tabellen vergleichen/Zeile kopieren

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread