PDA

Vollständige Version anzeigen : 2 Tabellen vergleichen und aktualisieren


nightbird
12.06.2001, 06:08
Hallo,

habe den Lösungsvorschlag von Klaus Dieter zum vergleichen zweier Tabellen gelesen und fand ihn Klasse.
Mein Problem geht etwas weiter.
Ich habe mir eine umfangreiche Tabelle erstellt und möchte die Daten nun mit den mir zugeschickten neuen Tabellen aktualisieren.Die Spalte A ist dabei fortlaufend numeriert.
Statt eines Ergebnisses "Gleich" oder "Ungleich" sollten die Daten aus den nachfolgenden Spalten eingefügt werden.
Also in etwa : Wenn [Tabelle Alt]A1 = [Tabelle Neu]A1, dann kopiere [Tabelle Neu]B1 nach [Tabelle Alt]B1. und diese dann fortlaufend bis zum Beispiel A100.
Somit hätte ich meine Daten auf dem neuesten Stand.
Für einen Lösungsvorschlag vielen Dank im voraus !!!
Gruß Frank

Klaus-Dieter
12.06.2001, 11:29
Hallo nightbird,

ich denke das bekomme ich hin, benötige allerdings etwas Zeit (ca. 2 Tage), da ich im Moment privat einiges um die Ohren habe. Es wäre hilfreich, wenn Du mir per eMail eine Beispieltabelle schickst, dann kann ich das "Maßschneidern".

nightbird
13.06.2001, 08:13
Hallo Klaus Dieter,

das Problem hat mir keine Ruhe gelassen, also
habe ich noch ein wenig rumprobiert...
Und siehe da : Es funktioniert !!!
Danke nochmal für Dein Angebot und für Deine Vorlage aus einem anderen Beitrag, den ich angepasst habe.

Hier meine Lösung :

Sub Tabellenvergleich()
Dim verg1(100), verg2(100)
Worksheets("Tabelle1").Activate
z = 1
Do While Cells(z, 1) <> ""
verg1(z) = Cells(z, 1)
z = z + 1
Loop
Worksheets("Tabelle2").Activate
y = 1
Do While Cells(y, 1) <> ""
verg2(y) = Cells(y, 1)
y = y + 1
Loop
For r = 1 To z - 1
If verg1(r) = verg2(r) Then
Sheets("Tabelle2").Activate
Cells(r, 2).Select
Selection.Copy
Sheets("Tabelle1").Activate
Cells(r, 2).Select
ActiveSheet.Paste
Sheets("Tabelle2").Activate
Cells(r, 3).Select
Selection.Copy
Sheets("Tabelle1").Activate
Cells(r, 3).Select
ActiveSheet.Paste
End If
Next r
End Sub

Gruß Frank

Klaus-Dieter
13.06.2001, 20:38
Hallo Frank,

in meinem Archiv habe ich ein Script zu Deiner Anfrage gefunden. Es ist etwas anders aufgebaut als Dein Lösungsansatz. Eventell hast Du daran Interesse. Zusätzlich zu der Änderung der Tabelle, werden die neu geänderten Zellen farblich hinterlegt.

Sub Tabellen_vergleichen_und_aktualisieren()
Dim verg1(200), verg2(299)
Worksheets("Tabelle1").Activate
z = 1
Do While Cells(z, 1) <> ""
verg1(z) = Cells(z, 2)
Range("B" & z).Select
Selection.Interior.ColorIndex = xlNone
z = z + 1
Loop
Worksheets("Tabelle2").Activate
y = 1
Do While Cells(y, 1) <> ""
verg2(y) = Cells(y, 2)
y = y + 1
Loop
For r = 1 To z - 1
If verg2(r) <> verg1(r) Then
Worksheets("Tabelle1").Activate
Cells(r, 2) = verg2(r)
Range("B" & r).Select
With Selection.Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
End If
Worksheets("Tabelle2").Activate
Next r
Worksheets("Tabelle1").Activate
End Sub

<font size="1" face="Century Gothic">Moderatorenanmerkung: die Überarbeitung dieses Beitrages ist im Zuge der Arbeiten zu sehen, die durch den Wechsel der Forensoftware zum 01.01.2003 verursacht wurden.

Es wurden in diesem Beitrag Links korrigiert, die auf falsche Adressen zeigten...</font>