Komprimieren einer Tabelle

Hi,
ich habe folgendes Problem:
Eine dynamische Tabelle, Daten kommen von einer Access-DB, hat ca. 9000 Zeilen (variabel) und 34 Spalten (fix). Aufgrund unterschiedlicher Merkmale (mehr als 300) werden bestimmte Zellen markiert. Im Prinzip sieht es wie folgt aus:
Land___Firma__Name__ID__Merk___Attr1___Attr2___Attr3
D_______x_____Hans___a___rot_____x
D_______x_____Hans___a___blau__________x
D_______x_____Hans___a___gelb________________x
D_______w_____Lisa___d___rot_____x
USA_____z_____Tom____b___blau__________x
USA_____z_____Tom____b___gelb________________x
USA_____y_____Beth___c___blau__________x
USA_____y_____Beth___c___rot_____x
Die Unterstriche dienen nur Formatierung!
Zuviel Information ist mehrfach vorhanden, deshalb soll eine neue Tabelle per Makro in einem neuem Arbeitsblatt entstehen, welche pro ID nur eine Zeile enthält, Spalte Merkmale entfällt dann.
Auf obiges Beispiel bezogen, würde es so aussehen:
Land___Firma__Name__ID__Attr1___Attr2___Attr3
D_______x_____Hans___a___x_______x_______x
D_______w_____Lisa___d___x
USA_____z_____Tom____b__________x_______x
USA_____y_____Beth___c___x_______x
Ich denke man muss jede einzelne ID als separaten Block betrachten und in ihm die Kreuze der Markierten Attribute in die erste Zeile des jeweiligen Blocks verschieben und danach alle anderen Zeilen des Blocks löschen. Dies ist für jede ID zu wiederholen.
Nur wie? Achtung bin Anfänger!
Über jede Hilfe bin ich sehr dankbar!
Hoffentlich hat es nicht die Formatierung versemmelt und die Mail ist für das Forum nicht zulang!
LG Thomas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

habe eine Lösung gefunden:
Die x zuerst durch 1 ersetzen.
Data/Subtotals (Daten/Teilsummen) aufrufen.
ID und Funktion "Sum" auswählen.
Alle Attribute als Subtotals auswählen.
Damit werden für die Attribute Teilsummen gebildet und das ganze ist nach ID sortiert.
Dann nur noch die Gliederungsebene zwei auswählen.
In einer gesonderten Tabelle nur mit den Spalten "Land/Firma/Name/ID" alle Doppeleinträge über "Data/Filter/Advanced Filter" das Kästchen "unique Records only" aktivieren.
Danach die beiden Ergebnisse (Subtotals und Unique Records) in einer Tabelle zusammenführen.
Diese Lösung hat nur den Haken, dass sie bei grossen Datenmengen versagt, da nicht genug Speicher vorhanden ist.
gruss Thomas

Sub reduceDB() Dim lngRow As Long For lngRow = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1 If Cells(lngRow, 1) = strLand And _ Cells(lngRow, 2) = strFirma And _ Cells(lngRow, 3) = strName And _ Cells(lngRow, 4) = strID Then If Cells(lngRow, 6) <> "" Then strAtt1 = Cells(lngRow, 6) End If If Cells(lngRow, 7) <> "" Then strAtt2 = Cells(lngRow, 7) End If If Cells(lngRow, 8) <> "" Then strAtt3 = Cells(lngRow, 8) End If Rows(lngRow + 1).Delete Else strLand = Cells(lngRow, 1) strFirma = Cells(lngRow, 2) strName = Cells(lngRow, 3) strID = Cells(lngRow, 4) If lngRow <> Cells(Rows.Count, 1).End(xlUp).Row Then Cells(lngRow + 1, 6) = strAtt1 Cells(lngRow + 1, 7) = strAtt2 Cells(lngRow + 1, 8) = strAtt3 End If If Cells(lngRow, 6) <> "" Then strAtt1 = Cells(lngRow, 6) End If If Cells(lngRow, 7) <> "" Then strAtt2 = Cells(lngRow, 7) End If If Cells(lngRow, 8) <> "" Then strAtt3 = Cells(lngRow, 8) End If End If Next Cells(lngRow + 1, 6) = strAtt1 Cells(lngRow + 1, 7) = strAtt2 Cells(lngRow + 1, 8) = strAtt3 End Sub

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread