Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1124to1128
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
Inhaltsverzeichnis

Daten zentral zusammenschreiben

Daten zentral zusammenschreiben
Steve
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

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Daten zentral zusammenschreiben
08.01.2010 02:36:17
fcs
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  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

Anzeige
AW: Daten zentral zusammenschreiben
09.01.2010 13:54:44
Steve
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.
AW: Daten zentral zusammenschreiben
09.01.2010 13:55:44
Steve
habe vergessen Frage als noch offen zu markieren, sorry.
AW: Daten zentral zusammenschreiben
09.01.2010 14:18:02
Steve
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.
Anzeige
AW: Daten zentral zusammenschreiben
10.01.2010 00:41:23
fcs
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  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

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige