Anzeige
Archiv - Navigation
284to288
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
284to288
284to288
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Zwei Tabellen abgleichen

Zwei Tabellen abgleichen
24.07.2003 09:31:21
Hans Juergen
Hallo Forum,
ich habe mal wieder ein Problem und keine Idee (passiert mir in letzter Zeit häufiger, ist wohl zu heiß) - und mit Suchen habe ich auch nichts gefunden, obwohl mit passenden Suchbegriffen sicher was zu finden wäre:
Ich habe 2 Tabellen mit Adressdaten (jede Zeile: Name, Vorname, Geburtstag, Klasse, usw.), die ich zusammenfügen will.
Hinter die Daten der 1. Tabelle (2003) möchte ich die passenden Daten der zweiten Tabelle (2002) einfügen, so dass ich nachher pro Name eine Zeile habe mit vorne den Daten von 2003 und dahinter jeweil den Daten von 2002.
Wenn es zu jeder Zeile aus 2003 eine aus 2002 geben würde, wäre es mit Sortieren und Kopieren einfach. Tatsächlich aber gibt es in beiden Tabellen Einträge, die jeweils in der anderen nicht enthalten sind (abgegangene und neu hinzugekommene Schüler). Die Kombination Name+Vorname ist eindeutig, darüber kann also zugeordnet werden.
Wichtig für mich ist, dass hinter den Daten 2003 alle passenden Daten von 2002 stehen (falls nicht vorhanden, dann leer). Die in 2003 nicht mehr vorhandenen Daten von 2002 sind nicht ganz so wichtig, wäre aber zu Kontrollzwecken nicht schlecht, wenn man sie auch sehen könnte.
Eine große Hilfe wäre es schon, aus beiden Tabellen einzeln die Zeilen extrahieren zu können, die in beiden gleichzeitig vorkommen (oder das Gegenteil davon). Den Rest könnte ich dann durch Sortieren und Kopieren leicht von Hand erledigen.
Das Ganze brauche ich nicht kommerziell, sondern als Kassenwart des Fördervereins einer Schule und ich stehe etwas unter Zeitdruck. Von Hand ist die Geschichte bei ca. 300 Zeilen pro Tabelle mit jeweils ca. 70 nicht-übereinstimmenden Zeilen leider sehr aufwendig.
Wer hat eine Idee, wer kann mir helfen?
Gruß
Hans Juergen
Hier noch mal bildlich:
2003:
N2 V2 G2 K2003.2 ...
N3 V3 G3 K2003.3 ...
N4 V4 G4 K2003.4 ...
N6 V6 G6 K2003.6 ...
2002:
N1 V1 G1 K2002.1 ...
N3 V3 G3 K2002.3 ...
N4 V4 G4 K2002.4 ...
N5 V5 G5 K2002.5 ...
Ergebnis:
N2 V2 G2 K2003.2 ... leer
N3 V3 G3 K2003.3 ... N3 V3 G3 K2002.3 ...
N4 V4 G4 K2003.4 ... N4 V4 G4 K2002.4 ...
N6 V6 G6 K2003.6 ... leer
leer N1 V2 G2 K2002.2 ... (ab hier nicht unbedingt erforderl.)
leer N5 V5 G5 K2005.2 ...

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zwei Tabellen abgleichen
24.07.2003 10:28:51
Nepumuk
Hallo Hans Juergen,
so sollte es funktionieren. Das Makro kommt in die Mappe, in der die Daten vereint werden. Diese Mappe ist im Programm die Mappe1. Ich bin jetzt mal davon ausgegangen, dass in beiden Mappen eine Überschriftenzeile besteht.

Option Explicit
Public Sub Hans_Juergen()
Dim Zelle As Range, Tab1 As Worksheet, Tab2 As Worksheet, Zeile As Long
Dim Adresse As String, gefunden As Boolean, freie_Zeile As Long
Set Tab1 = Workbooks("Mappe1.xls").Worksheets(1) 'hier Mappenname und Tabellennummer anpassen
Set Tab2 = Workbooks("Mappe2.xls").Worksheets(1) 'hier Mappenname und Tabellennummer anpassen
For Zeile = 2 To Tab1.Cells(65536, 1).End(xlUp).Row 'wenn keine Überschrift, dann mit 1 beginnen
If Trim(Tab1.Cells(Zeile, 1)) <> "" Then
Set Zelle = Tab2.Range("A2:A65536").Find(What:=Trim(Tab1.Cells(Zeile, 1)), LookIn:=xlValues, LookAt:=xlWhole)
If Not Zelle Is Nothing Then
Adresse = Zelle.Address
Do
If Tab2.Cells(Zelle.Row, 2) = Tab1.Cells(Zeile, 2) And Tab2.Cells(Zelle.Row, 3) = Tab1.Cells(Zeile, 3) Then
Tab1.Range(Tab1.Cells(Zeile, 5), Tab1.Cells(Zeile, 8)) = Tab2.Range(Tab2.Cells(Zelle.Row, 1), Tab2.Cells(Zelle.Row, 4)).Value
Exit Do
End If
Set Zelle = Tab2.Range("A2:A65536").FindNext(Zelle)
Loop While Not Zelle Is Nothing And Zelle.Address <> Adresse
End If
End If
Next
For Zeile = 2 To Tab2.Cells(65536, 1).End(xlUp).Row 'wenn keine Überschrift, dann mit 1 beginnen
If Trim(Tab2.Cells(Zeile, 1)) <> "" Then
gefunden = False
Set Zelle = Tab1.Range("A2:A65536").Find(What:=Trim(Tab2.Cells(Zeile, 1)), LookIn:=xlValues, LookAt:=xlWhole)
If Not Zelle Is Nothing Then
Adresse = Zelle.Address
Do
If Tab1.Cells(Zelle.Row, 2) = Tab2.Cells(Zeile, 2) And Tab1.Cells(Zelle.Row, 3) = Tab2.Cells(Zeile, 3) Then
gefunden = True
Exit Do
End If
Set Zelle = Tab1.Range("A2:A65536").FindNext(Zelle)
Loop While Not Zelle Is Nothing And Zelle.Address <> Adresse
End If
If Not gefunden Then
freie_Zeile = Tab1.Cells(65536, 1).End(xlUp).Row + 1
If freie_Zeile < Tab1.Cells(65536, 5).End(xlUp).Row + 1 Then freie_Zeile = Tab1.Cells(65536, 5).End(xlUp).Row + 1
Tab1.Range(Tab1.Cells(freie_Zeile, 5), Tab1.Cells(freie_Zeile, 8)) = Tab2.Range(Tab2.Cells(Zeile, 1), Tab2.Cells(Zeile, 4)).Value
End If
End If
Next
End Sub


Code eingefügt mit: Excel Code Jeanie
Gruß
Nepumuk

Anzeige
AW: Zwei Tabellen abgleichen - danke !!!
26.07.2003 14:58:58
Hans Juergen
Hallo Nepumuk,
ich kann dieses Forum und den Einsatz der Mitglieder nur bewundern. Wie letztens schon gesagt, Einstein mit seiner Lichtgeschwindigkeit ist lahm im Vergleich zu den Antworten hier im Forum.
Ich hoffe, Du hast dieses lange Programm nicht nur extra für mich geschrieben, sondern hast es aus Deinen eigenen Programmierungen ausgegraben. Egal wie - vielen Dank dafür!
Mit ein paar kleinen Modifikationen habe ich meine Tabellen in kurzer Zeit so hinbekommen, wie ich sie brauchte.
Gruß
Hans Jürgen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige