3.3k Aufrufe
Gefragt in Skripte(PHP,ASP,Perl...) von
Hallo,

ich bin gerade dabei ein Makro zu erstellen und möchte dabei eine
Tabelle zusammenfassen. Dabei sollen alle Zeilen von der Spalte F
durchsucht werden. Falls der Inhalt (String) gleich ist, soll der Wert
(Int) das in der gleichen Zeile, aber in Spalte E, ist aufaddiert werden
und somit soll die Tabelle kleiner werden um unnötige Zeilen zu
sparen:

Datum X Y Z Wert Text

2.3 a b c 4 bla

3.5 a b c 8 lala

9.6 a b c 3 bla

5.2 a b c 5 lala

- - - c 20

aus dieser Tabelle soll werden:

Datum X Y Z Wert Text

2.3 a b c 7 bla

3.5 a b c 13 lala

- - - c 20

(Sorry man kann die Spalten so schlecht darstellen. "-" steht für
Leerstelle und es sind insgesamt 5 Spalten; die erste Zeile ist der
Tabellenkopf)

Ich bin leider noch Anfänger und hab ziemlich Probleme wegen der
Dynamik. Manche Tabellen haben wenige Zeilen und manche sehr
viele Zeilen. Über Hilfe würde ich mich wirklicn sehr freuen :) [quote]

Liebe Grüße
eday

4 Antworten

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo eday,

leider kann ich mit deinem Beispiel nichts anfangen. Lade doch mal eine Beispieldatei mit ein paar Dummy-Daten bei einem Hoster (z.B. hier) hoch und poste den Link hier im Forum.

Deine Beispieldatei sollte ein paar Dummy-Daten enthalten und stelle darin auch dar, wie die Daten nach dem Bearbeiten aussehen sollen.

Gruß

M.O.
0 Punkte
Beantwortet von
Hallo M.O.

vielen Dank für deine schnelle Antwort :)
hier ist der Link für ein Beispiel der Tabelle:
http://www33.zippyshare.com/v/Sg9akbIu/file.html

Viele Grüße
eday
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo eday,

probier mal das folgende Makro aus:

Sub zusammenfassen()
Dim strNameQ As String
Dim strNameZ As String
Dim inlzeileQ As Integer
Dim zaehler As Integer
Dim z As Integer
Dim f As Integer
Dim ws As Worksheet
Dim bExists As Boolean
Dim arrFeld

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Name des aktiven Arbeitsblattes in Variable schreiben
strNameQ = ActiveSheet.Name

'Name des Arbeitsblattes mit Zusammenfassung generieren
strNameZ = strNameQ & "_z"

'Prüfen ob das Arbeitsblatt mit der Zusammenfassung ggf. schon vorhanden ist
For Each ws In Worksheets
If ws.Name = strNameZ Then
bExists = True: Exit For
End If
Next

'Falls das Arbeitsblatt nicht existiert, Arbeitsblatt anlegen
If bExists = False Then
'Neues Blatt wird am Ende eingefügt
Worksheets.Add After:=ActiveSheet
'Neues Blatt benennen
ActiveSheet.Name = strNameZ
Else
'Falls das neue Arbeitsblatt existiert, dann vorhandene Daten löschen
With Worksheets(strNameZ)
.Range(.Cells(1, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, .UsedRange.SpecialCells(xlCellTypeLastCell).Column)).Clear
End With
End If

'Überschrift in die Zusammenfassung kopieren
Worksheets(strNameQ).Rows(1).Copy Destination:=Worksheets(strNameZ).Cells(1, 1)

'letzte Zeile der Quell-Tabelle ermitteln und in Variable schreiben
intlZeileQ = Worksheets(strNameQ).Cells(Rows.Count, 1).End(xlUp).Row

'Feld dimensionieren für Daten
ReDim arrFeld(intlZeileQ, 5)

'Zeilen durchlaufen
For z = 2 To intlZeileQ
'Feld durchlaufen
For f = 0 To zaehler
If Worksheets(strNameQ).Cells(z, 6) = arrFeld(f, 5) Then
bExists = True
Exit For
Else
bExists = False
End If
Next f
'Falls eingelesener Text nicht gefunden, dann neuen Satz ins Array schreiben
If bExists = False Then
For f = 1 To 6
arrFeld(zaehler, f - 1) = Worksheets(strNameQ).Cells(z, f)
Next f
'Summmewenn wird ermittelt und in Array geschrieben
With Worksheets(strNameQ)
arrFeld(zaehler, 4) = WorksheetFunction.SumIf(.Range(.Cells(2, 6), .Cells(intlZeileQ, 6)), .Cells(z, 6), .Range(.Cells(2, 5), .Cells(intlZeileQ, 5)))
End With
'Zähler erhöhen
zaehler = zaehler + 1
End If
Next z

'Array in Zieltabelle schreiben
For z = 0 To zaehler
For f = 0 To 5
Worksheets(strNameZ).Cells(2 + z, 1 + f) = arrFeld(z, f)
Next f
Next z

'auf Zieltabelle wechseln
Worksheets(strNameZ).Select
With Worksheets(strNameZ)
.Range("A1:F1").Font.Bold = True 'Überschrift Fett
.Columns("A:A").NumberFormat = "dd/mmm" 'Spalte A formatieren
.Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 5).FormulaLocal = "=Summe(E2:E" & .Cells(Rows.Count, 1).End(xlUp).Row & ")" 'Summenformel einfügen
.Cells(.Cells(Rows.Count, 5).End(xlUp).Row, 5).Select
End With

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub


Das Makro gehört in ein allgemeines Modul deiner Arbeitsmappe. Für die Zusammenfassung wird eine neue Tabelle angelegt.
Damit die Zusammenfassung funktioniert, müssen die Begriffe in Spalte F indentisch sein (ein Leerzeichen zuviel - wie z.B. in Tabelle 1, Zeile 4 deiner Beispieldatei - und schon hast du eine weitere Zeile).

Gruß

M.O.
0 Punkte
Beantwortet von
Hallo M.O.,

Danke für deine Hilfe! :)


Viele Grüße
Eday
...