Thema: Daten zentral zusammenschreiben | Herbers Excel-Forum

Hi,
ich glaube ich brauche nochmals eure VBA-Kenntnisse. Folgende Tabelle:
https://www.herber.de/bbs/user/67045.xlsx
Das Skript müsste folgendes erledigen:
1. Prüfe alle Tabellenblätter, die mit "VP" beginnen
2. Vergleiche "Letztes Versanddatum" und "letztes Änderungsdatum"
3. wenn letztes Änderungsdatum größer dann kopiere Projektname
4. wenn letztes Änderungsdatum größer dann die jeweilige Zeile mit Name, ASP, Tel Allg, Tel ASP
Kann man so etwas machen oder geht das vielleicht auch irgendwie per FOrmel?
LG
Steve

Hallo Steve,
die Formeln zur Übernahme wären ziemlich kompliziert.
Kannst ja mal auf http://www.excelformeln.de/formeln.html?gruppe=3 prüfen, ob dort was passendes zu finden ist. Gibt etwas kompliziertes zusammengesetzt aus INDEX, KKLEINSTE, WENN und ZEILE.
Hier meine Makro-Lösung, die auf die von dir angelegten Tabellen(Listen)-Objekte in den Tabellenblättern zugeschnitten ist.
Gruß
Franz

Sub Listenabgleich()
Dim wksVP As Worksheet, oListeVersP As ListObject, sProjekt As String
Dim wksVersand As Worksheet, oListeVers As ListObject
Dim datLetzterVersand As Date, ZeileVers As Long, ZeileVP As Long, Zeile As Long
'Objekte und Infos im Blatt Katalogversendung
Set wksVersand = Worksheets("Katalogversendung")
Set oListeVers = wksVersand.ListObjects(1)
datLetzterVersand = wksVersand.Range("B1").Value
'Letzte Zeile mit Daten im Bereich der Katalogversand-Daten
With oListeVers.DataBodyRange
ZeileVers = 0
For Zeile = .Rows.Count To 1 Step -1
If Not IsEmpty(.Cells(Zeile, 1)) Then
ZeileVers = Zeile
Exit For
End If
Next
End With
'VP-Blätter abarbeiten
Application.ScreenUpdating = False
For Each wksVP In ActiveWorkbook.Worksheets
'Ersten beiden Zeichen des Blattnamens prüfen
If Left(wksVP.Name, 2) = "VP" Then
'Listen-Objekt setzen
Set oListeVersP = wksVP.ListObjects(1)
'Projektname auslesen
sProjekt = wksVP.Range("B1").Text
With oListeVersP.DataBodyRange
'Zeilen in Liste abarbeiten
For ZeileVP = 1 To .Rows.Count
'Vergleich Änderungsdatum mit letztem Versanddatum
If datLetzterVersand < .Cells(ZeileVP, 9) Then
'Zeilenzähler erhöhen
ZeileVers = ZeileVers + 1
'Prüfen, ob Zähler größer als Datenbereich der Liste/Tabelle im Versandblatt
If ZeileVers > oListeVers.DataBodyRange.Rows.Count Then
'Liste/Tabelle um eine Zeile vergrößern
oListeVers.ListRows.Add
End If
'Daten übertragen
oListeVers.DataBodyRange.Cells(ZeileVers, 1) = sProjekt
oListeVers.DataBodyRange.Cells(ZeileVers, 2) = .Cells(ZeileVP, 1) 'Firma-Name
oListeVers.DataBodyRange.Cells(ZeileVers, 3) = .Cells(ZeileVP, 2) 'Firma ASP
oListeVers.DataBodyRange.Cells(ZeileVers, 4) = .Cells(ZeileVP, 6) 'Info-Brief
oListeVers.DataBodyRange.Cells(ZeileVers, 5) = .Cells(ZeileVP, 7) 'Info-Mail
oListeVers.DataBodyRange.Cells(ZeileVers, 6) = .Cells(ZeileVP, 9) 'Änderung
End If
Next
End With
End If
Next
Application.ScreenUpdating = True
End Sub

Prima funktioniert sehr gut. Ich habe einen Punkt vergessen. Kann man noch eine Überprüfung einbauen, dass wenn ein Kreuz bei Infomaterial erhalten drin ist diese Zeile übersprungen wird, da man sonst das Problem hat (ich habe in der echten Tabelle noch mehr Spalten dahinter), dass bei einem neueren Aktualisierungsdatum auch die Zeile nochmals wiedergegeben wird.
Vielen Dank im Voraus.

habe vergessen Frage als noch offen zu markieren, sorry.

Was auch noch nicht so richtig funktioniert. er soll pro Zeile abprüfen, ob auch tatsächlich ein Kreuz bei Infomaterial per Mail oder Post drin ist, wenn nicht muss die Zeile übersprungen werden. So wie es jetzt ist, kopiert er alles, sobald er etwas gefunden hat.

Hallo Steve,
ich jetzt auch noch herausgefunden, das man bei Listen-Objekten, die Spalten auch über den Spaltentitel ansprechen kann. Deshalb hier das Makro überarbeitet inkl. der zusätzlichen Prüfungen auf "x" in bestimmten Spalten.
Gruß
Franz

Sub Listenabgleich1()
Dim wksVP As Worksheet, oListeVP As ListObject, sProjekt As String
Dim wksVersand As Worksheet, oListeVersand As ListObject
Dim rngVersand As Range
Dim SpalteVers As ListColumns, SpalteVP As ListColumns
Dim datLetzterVersand As Date
Dim ZeileVers As Long, ZeileVP As Long, Zeile As Long
'Objekte und Infos im Blatt Katalogversendung
Set wksVersand = Worksheets("Katalogversendung")
Set oListeVersand = wksVersand.ListObjects(1)
Set SpalteVers = oListeVersand.ListColumns
Set rngVersand = oListeVersand.DataBodyRange
datLetzterVersand = wksVersand.Range("B1").Value
'Letzte Zeile mit Daten im Bereich der Katalogversand-Daten
With rngVersand
ZeileVers = 0
For Zeile = .Rows.Count To 1 Step -1
If Not IsEmpty(.Cells(Zeile, SpalteVers("Projekt").Index)) Then
ZeileVers = Zeile
Exit For
End If
Next
End With
'VP-Blätter abarbeiten
Application.ScreenUpdating = False
For Each wksVP In ActiveWorkbook.Worksheets
'Ersten beiden Zeichen des Blattnamens prüfen
If Left(wksVP.Name, 2) = "VP" Then
'Listen-Objekt setzen
Set oListeVP = wksVP.ListObjects(1)
Set SpalteVP = oListeVP.ListColumns
'Projektname auslesen
sProjekt = wksVP.Range("B1").Text
With oListeVP.DataBodyRange
'Zeilen in Liste abarbeiten
For ZeileVP = 1 To .Rows.Count
'Vergleich Änderungsdatum mit letztem Versanddatum
If datLetzterVersand < .Cells(ZeileVP, SpalteVP("Datum Änderung").Index) Then
'Prüfen, ob X bei "Infomaterial erhalten""
If LCase(.Cells(ZeileVP, SpalteVP("Infomaterial erhalten?").Index)) = "x" Then
'Zeile überspringen
Else
'Prüfen, ob X bei "per Post" oder "e-Mail"
If LCase(.Cells(ZeileVP, SpalteVP("Infomaterial per Post").Index)) = "x" _
Or LCase(.Cells(ZeileVP, SpalteVP("Infomaterial per Mail").Index)) = "x" Then
'Zeilenzähler erhöhen
ZeileVers = ZeileVers + 1
'Prüfen, ob Zähler größer als Datenbereich der Liste/Tabelle im Versandblatt
If ZeileVers > rngVersand.Rows.Count Then
'Liste/Tabelle um eine Zeile vergrößern
oListeVersand.ListRows.Add
Set rngVersand = oListeVersand.DataBodyRange
End If
'Daten übertragen
rngVersand.Cells(ZeileVers, SpalteVers("Projekt").Index) = sProjekt
rngVersand.Cells(ZeileVers, SpalteVers("Firmenname").Index) = _
.Cells(ZeileVP, SpalteVP("Firmenname").Index)
rngVersand.Cells(ZeileVers, SpalteVers("ASP-Name").Index) = _
.Cells(ZeileVP, SpalteVP("ASP-Name").Index)
rngVersand.Cells(ZeileVers, SpalteVers("Infomaterial per Post").Index) = _
.Cells(ZeileVP, SpalteVP("Infomaterial per Post").Index)
rngVersand.Cells(ZeileVers, SpalteVers("Infomaterial per Mail").Index) = _
.Cells(ZeileVP, SpalteVP("Infomaterial per Mail").Index)
rngVersand.Cells(ZeileVers, SpalteVers("Datum Änderung").Index) = _
.Cells(ZeileVP, SpalteVP("Datum Änderung").Index)
End If
End If
End If
Next
End With
End If
Next
Application.ScreenUpdating = True
End Sub