Zeilen vergleichen und bestimmte Spalte addieren
Hallo Zusammen.
Ich bin Anfänger in VBA, habe keine Ahnung wie ich mein problem lösen soll.
Ich habe eine Tabelle mit unterschiedlichen Zeilen. Insgesamt habe ich über 4000 Zeilen zu vergleichen
Jetzt möchte ich die Zeilen miteinander vergleichen und zwar bestimmte Spalten.
In Tabelle1 nehme ich die erste Zeile und vergleiche ihre Spalten mit den Spalten aller vorhandenen Zeilen.
Wenn die Spalten A, B, C und D von Zeile1 gleich sind mit den Spalten aller Zeilen, dann nehme ich die Spalte "Beitrag" von den betroffenen Zeilen, addiere sie zusammen, mache eine neue Zeile daraus und speichere die Zeile in Tabelle2.
Wenn eine Zeile nicht doppelt vorkommt wird sie unverändert in Tabelle2 kopiert.
Die Bilder zeigen wie die Tabelle2 aussehen sollte.
Tabelle1:
Tabelle2:
Ich wäre sehr dankbar, wenn mir jemand helfen könnte.
Gruß
Christian
Ich bin Anfänger in VBA, habe keine Ahnung wie ich mein problem lösen soll.
Ich habe eine Tabelle mit unterschiedlichen Zeilen. Insgesamt habe ich über 4000 Zeilen zu vergleichen
Jetzt möchte ich die Zeilen miteinander vergleichen und zwar bestimmte Spalten.
In Tabelle1 nehme ich die erste Zeile und vergleiche ihre Spalten mit den Spalten aller vorhandenen Zeilen.
Wenn die Spalten A, B, C und D von Zeile1 gleich sind mit den Spalten aller Zeilen, dann nehme ich die Spalte "Beitrag" von den betroffenen Zeilen, addiere sie zusammen, mache eine neue Zeile daraus und speichere die Zeile in Tabelle2.
Wenn eine Zeile nicht doppelt vorkommt wird sie unverändert in Tabelle2 kopiert.
Die Bilder zeigen wie die Tabelle2 aussehen sollte.
Tabelle1:
Tabelle2:
Ich wäre sehr dankbar, wenn mir jemand helfen könnte.
Gruß
Christian
Please also mark the comments that contributed to the solution of the article
Content-Key: 161812
Url: https://administrator.de/contentid/161812
Printed on: April 24, 2024 at 16:04 o'clock
6 Comments
Latest comment
Hallo linBid23 und willkommen im Forum!
Mit einer Ausnahme (die Spalte "Eintragsdatum" in der Tabelle2 ist - insbesondere, wenn mehrere Zeilen zusammengefasst wurden - eigentlich nicht sinnvoll und wird daher nicht befüllt) sollte das folgende Script Deine Anforderung erfüllen:
Um die Formatierungen (zB der Überschriftenzeile) in der Zieltabellemusst Du Dich selbst kümmern - allerdings werden diese, anders als die Zellinhalte, durch das Script nicht gelöscht ...
Grüße
bastla
Mit einer Ausnahme (die Spalte "Eintragsdatum" in der Tabelle2 ist - insbesondere, wenn mehrere Zeilen zusammengefasst wurden - eigentlich nicht sinnvoll und wird daher nicht befüllt) sollte das folgende Script Deine Anforderung erfüllen:
Sub Konsolidieren()
QTabelle = "Tabelle1" 'Quelltabelle
QAbZeile = 1 'Überschriftenzeile in Quelltabelle
QAbSpalte = 1 'Nummer der 1. Datenspalte in Quelltabelle
QBSpalte = "F" 'Spalte für Betrag in Quelltabelle
Spalten = 4 'Spaltenanzahl für Vergleich
ZTabelle = "Tabelle2" 'Zieltabelle
ZAbZeile = 1 'Überschriftenzeile in Zieltabelle
ZAbSpalte = 1 'Nummer der 1. Datenspalte in Zieltabelle
ZBSpalte = "F" 'Spalte für Betag in Zieltabelle
Delim = "§" 'Trennzeichen - darf in den Daten nicht vorkommen
Set d = CreateObject("Scripting.Dictionary") 'Dictionary zum Zwischenspeichern der (konsolidierten) Zeile erzeugen
QZeile = QAbZeile 'in Überschriftenzeile der Quelltabelle starten
With Worksheets(QTabelle)
Do Until .Cells(QZeile, QAbSpalte) = "" 'Zeilen bearbeiten, bis in erster Spalte kein Wert mehr vorhanden
K = "" 'Schlüssel initialisieren
For i = 0 To Spalten - 1 'alle Schlüsselspalten durchgehen
K = K & Delim & .Cells(QZeile, QAbSpalte + i) 'Schlüssel zusammensetzen
Next
K = Mid(K, 2) 'erstes Zeichen ist ein Trennzeichen - weglassen
Betrag = .Cells(QZeile, QBSpalte) 'Betrag auslesen
If d.Exists(K) Then 'Wenn schon ein Eintrag für diesen Schlüssel vorhanden, ...
d.Item(K) = d.Item(K) + Betrag '... Betrag addieren, ...
Else
d.Add K, Betrag '... ansonsten Eintrag erstellen
End If
QZeile = QZeile + 1 'nächste Zeile der Quelltabelle
Loop
End With
T = d.Keys 'Schlüssel-Texte in Array übernehmen
B = d.Items 'Beträge detto
With Worksheets(ZTabelle)
.Cells.ClearContents 'Zieltabelle löschen
ZZeile = ZAbZeile 'in Überschriftenzeile der Zieltabelle beginnen
For i = 0 To UBound(T) 'alle konsolidierten Einträge durchgehen
'Schlüssel-Text wieder in Spalten zerlegen und eintragen
.Cells(ZZeile, ZAbSpalte).Resize(1, Spalten) = Split(T(i), Delim)
.Cells(ZZeile, ZBSpalte) = B(i) 'Betrag(ssumme) eintragen
ZZeile = ZZeile + 1 'nächste Zeile der Zieltabelle
Next
End With
End Sub
Grüße
bastla
Hallo linBid23!
Ich möchte Dich ja nicht von Deinen Anpassungsversuchen abhalten, aber wenn Du wirklich Anfänger bist, könnte das etwas dauern ...
Bei Bedarf kannst Du zwischenzeitlich auf diesen Ansatz zurückgreifen:
Grüße
bastla
Ich möchte Dich ja nicht von Deinen Anpassungsversuchen abhalten, aber wenn Du wirklich Anfänger bist, könnte das etwas dauern ...
Bei Bedarf kannst Du zwischenzeitlich auf diesen Ansatz zurückgreifen:
Sub Konsolidieren()
QTabelle = "Tabelle1" 'Quelltabelle
QAbZeile = 1 'Überschriftenzeile in Quelltabelle
QAbSpalte = 1 'Nummer der 1. Datenspalte in Quelltabelle
QDatumSpalte = "E" 'Spalte für Eintragsdatum in Quelldatei
QBSpalte = "F" 'Spalte für Betrag in Quelltabelle
Spalten = 4 'Spaltenanzahl für Vergleich
ZTabelle = "Tabelle2" 'Zieltabelle
ZAbZeile = 1 'Überschriftenzeile in Zieltabelle
ZAbSpalte = 1 'Nummer der 1. Datenspalte in Zieltabelle
ZDatumSpalte = "E" 'Spalte für Eintragsdatum in Zieldatei
ZBSpalte = "F" 'Spalte für Betag in Zieltabelle
Delim = "§" 'Trennzeichen - darf in den Daten nicht vorkommen
Set d = CreateObject("Scripting.Dictionary")
QZeile = QAbZeile 'in Überschriftenzeile der Quelltabelle starten
With Worksheets(QTabelle)
Do Until .Cells(QZeile, QAbSpalte) = "" 'Zeilen bearbeiten, bis in erster Spalte kein Wert mehr vorhanden
K = "" 'Schlüssel initialisieren
For i = 0 To Spalten - 1 'alle Schlüsselspalten durchgehen
K = K & Delim & .Cells(QZeile, QAbSpalte + i) 'Schlüssel zusammensetzen
Next
K = Mid(K, 2) 'erstes Zeichen ist ein Trennzeichen - weglassen
EinDat = .Cells(QZeile, QDatumSpalte) 'Eintragsdatum auslesen
Betrag = .Cells(QZeile, QBSpalte) 'Betrag auslesen
If d.Exists(K) Then 'Wenn schon ein Eintrag für diesen Schlüssel vorhanden, ...
V = Split(d.Item(K), Delim) '... gespeicherte Wertekombination "Datum§Betrag" zerlegen, ...
V(1) = V(1) + Betrag '... Betrag addieren und ...
d.Item(K) = Join(V, Delim) '... wieder zusammensetzen und eintragen; ...
Else
d.Add K, EinDat & Delim & Betrag '... ansonsten Eintrag als Kombination "Datum§Betrag" erstellen
End If
QZeile = QZeile + 1 'nächste Zeile der Quelltabelle
Loop
End With
T = d.Keys 'Schlüssel-Texte in Array übernehmen
B = d.Items 'Datumswerte und Beträge detto
With Worksheets(ZTabelle)
.Cells.ClearContents 'Zieltabelle löschen
ZZeile = ZAbZeile 'in Überschriftenzeile der Zieltabelle beginnen
For i = 0 To UBound(T) 'alle konsolidierten Einträge durchgehen
'Schlüssel-Text wieder in Spalten zerlegen und eintragen
.Cells(ZZeile, ZAbSpalte).Resize(1, Spalten) = Split(T(i), Delim)
V = Split(B(i), Delim) 'Kombination "Datum§Betrag" zerlegen
.Cells(ZZeile, ZDatumSpalte) = V(0) 'Eintragsdatum eintragen
.Cells(ZZeile, ZBSpalte) = V(1) 'Betrag(ssumme) eintragen
ZZeile = ZZeile + 1 'nächste Zeile der Zieltabelle
Next
End With
End Sub
bastla
Hallo linBid23!
Freut mich, dass es Dir hilft - aber lass mal die Kirche im Dorf ...
... was ich aber auf jeden Fall empfehlen kann: learning by doing
Grüße
bastla
Freut mich, dass es Dir hilft - aber lass mal die Kirche im Dorf ...
kannst du mir ein Tipp geben, wo ich anfangen sollte?
Nicht wirklich - ist bei mir schon etwas länger (aber nicht sehr viel über 30 Jahre ) her, dass ich mit Basic angefangen habe ...... was ich aber auf jeden Fall empfehlen kann: learning by doing
Grüße
bastla