Tabellen Alt und Neu synchronisieren

Hallo allerseits!
Aufgrund der guten Erfahrungen vor ein paar Jahren, möchte ich mich gerne mit meiner aktuellen Frage an euch wenden. Ich bedanke mich schonmal vorab für alle Unterstützer!!
Das Problem:
Ich bekomme wöchentlich eine Liste mit aktuellen Verkaufschancen. Die Liste enthält also wichtige Daten, wie Zeitplan, Werte,... allerdings ergänze ich für mich hier wichtige Dinge, die ich dann mit den Kollegen bespreche.
Das muss ich dann immer auf die neuen Listen übertragen.
Da ich das nicht nur in einem Land habe und häufig viele Projekte betroffen sind, hoffe ich das automatisieren zu können.
Alle Daten sind an drei Spalten geknüpft, die immer identisch sind, da Sie im System nur einmal hinterlegt werden. Das sind Betreiber, Bauobjekt, und Projekt. Also Beispielsweise: Die Bank V. (Betreiber) baut in ihrer Filiale XY (Bauobjekt) einen neuen Parkplatz Z (Projekt).
Mein Hauptziel ist es also, dass ich die neue Liste komplett nehmen kann und die alten Daten durch die neuen automatisch überschreiben, ergänzen und markieren kann.
Also so eine Art Befehl:
- Liebes Excel schau bitte nach ob in der alten Liste alle 3 wichtigen Spalten von jeder Zeile identisch in der Neuen
zu finden sind (Die Zeilenreihenfolge kann variieren, genau das macht es sehr schwer)
- Wenn nicht, dann ergänze die komplette Spalte der neuen in der alten Liste und markiere diese rot
- Falls die 3 Felder (wichtig: immer ganze Zeilen vergleichen) da sind, vergleiche alle anderen. Sollten dies
unterschiedlich sein, kopiere den neuen Wert in die alte Liste und markiere diesen Wert rot.
- Liebes Excel schau bitte auch nach, ob in der neuen Liste Werte nicht mehr enthalten sind, die in der alten noch
da waren und markiere diese gelb
Hier noch ein Beispielbild, das ich mal erstellt habe. URL zum einfügen im Browser:
http://img5.fotos-hochladen.net/uploads/erluterung9liyj53edc.jpg
Und hier noch als Exceltabelle, allerdings beide auf einem Blatt (wegen Screenshot):
https://www.herber.de/bbs/user/80634.xlsx

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Andreas,
hier ein entprechendes Makro für den Abgleich. Tabellenblattnamen und Startzeilen muss du ggf. noch anpassen.
Die Größe des Tabellen-Objekt-Bereichs in der Altliste muss du nach dem durchlauf des Makros noch anpassen.
Makro bitte in Kopie der Arbeitsmappe Testen!!! Funktion ohne Gewähr.
Gruß
Franz

Sub VergleichAltNeu()
Dim wksAlt As Worksheet, wksNeu As Worksheet
Dim varPlant, varProjekt, varBetreiber
Dim lngSpaltenN As Long 'Anzahl Spalten in neuer Liste
Dim lngZeiN As Long, lngZeiN1 As Long, lngZeiLastN As Long
Dim lngZeiA As Long, lngZeiA1 As Long, lngZeiLastA As Long
Dim lngSpa As Long
Dim bolFound As Boolean
Application.ScreenUpdating = False
Set wksNeu = ActiveWorkbook.Worksheets("ListeNeu")  'Name anpassen!!
Set wksAlt = ActiveWorkbook.Worksheets("ListeAlt")  'Name anpassen!!
With wksNeu
lngZeiN1 = 2 '1. Zeile mit Daten in neuer Liste (Zeile unter Spaltentiteln) 'ggf. anpassen!! _
lngZeiLastN = .Cells(.Rows.Count, 1).End(xlUp).Row
lngSpaltenN = .Cells(lngZeiN1 - 1, .Columns.Count).End(xlToLeft).Column 'ggf. fest vorgeben
End With
With wksAlt
lngZeiA1 = 2 '1. Zeile mit Daten in alter Liste (Zeile unter Spaltentiteln)'ggf. anpassen!!
lngZeiLastA = .Cells(.Rows.Count, 1).End(xlUp).Row
If Not IsNumeric(.Cells(lngZeiLastA, 1).Value) Or .Cells(lngZeiLastA, 1).Value = "" Then
Do Until lngZeiLastA = lngZeiA1 - 1
lngZeiLastA = lngZeiA1 - 1
If IsNumeric(.Cells(lngZeiLastA, 1)) Then Exit Do
Loop
End If
If lngZeiLastA >= lngZeiA1 Then
'Füllfarben zurücksetzen
With .Range(.Cells(lngZeiA1, 1), .Cells(lngZeiLastA, lngSpaltenN))
.Interior.ColorIndex = xlColorIndexNone
End With
End If
End With
'Alte Liste mit neuer Liste ableichen
With wksAlt
For lngZeiA = lngZeiA1 To lngZeiLastA
varPlant = .Cells(lngZeiA, 2).Value
varProjekt = .Cells(lngZeiA, 3).Value
varBetreiber = .Cells(lngZeiA, 4).Value
bolFound = False
'Die Schlüssel in neuer Liste suchen
With wksNeu
For lngZeiN = lngZeiN1 To lngZeiLastA
If .Cells(lngZeiN, 2).Value = varPlant And _
.Cells(lngZeiN, 3).Value = varProjekt And _
.Cells(lngZeiN, 4).Value = varBetreiber Then
bolFound = True
Exit For
End If
Next lngZeiN
End With
If bolFound = False Then
'Eintrag in neuer Liste nicht mehr vorhanden
wksAlt.Rows(lngZeiA).Interior.ColorIndex = 6 'ganze Zeile Gelb
Else
'Spaltenvergleichen
For lngSpa = 5 To lngSpaltenN
With wksAlt.Cells(lngZeiA, lngSpa)
If .Value  wksNeu.Cells(lngZeiN, lngSpa).Value Then
.Interior.ColorIndex = 3 'Rot einfärben
End If
End With
Next lngSpa
End If
Next lngZeiA
End With
'Neue Liste mit alter Liste ableichen - neue Einträge suchen/kopieren
With wksNeu
For lngZeiN = lngZeiN1 To lngZeiLastN
varPlant = .Cells(lngZeiN, 2).Value
varProjekt = .Cells(lngZeiN, 3).Value
varBetreiber = .Cells(lngZeiN, 4).Value
bolFound = False
'Die Schlüssel in alter Liste suchen
With wksAlt
For lngZeiA = lngZeiA1 To lngZeiLastA
If .Cells(lngZeiA, 2).Value = varPlant And _
.Cells(lngZeiA, 3).Value = varProjekt And _
.Cells(lngZeiA, 4).Value = varBetreiber Then
bolFound = True
Exit For
End If
Next lngZeiA
End With
If bolFound = False Then
'Neuer Eintrag in neuer Liste nicht in alter vorhanden
lngZeiLastA = lngZeiLastA + 1
wksNeu.Rows(lngZeiN).Copy Destination:=wksAlt.Cells(lngZeiLastA, 1)
wksAlt.Rows(lngZeiLastA).Interior.ColorIndex = 3 'rot
'Nummer in Spalte A erhöhen
If lngZeiLastA = lngZeiA1 Then
wksAlt.Cells(lngZeiLastA - 1, 1) = 1
Else
wksAlt.Cells(lngZeiLastA, 1) = wksAlt.Cells(lngZeiLastA - 1, 1) + 1
End If
End If
Next lngZeiN
End With
Fehler:
With Err
Select Case .Number
Case 0 'alles OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
Application.ScreenUpdating = True
End Sub

Beliebteste Forumthreads (12 Monate)

Tabellen Alt und Neu synchronisieren

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread