Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1192to1196
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

Mehrere Datensätze zusammenfassen

Mehrere Datensätze zusammenfassen
Kai
Hallo
ich hoffe mal, ich kann mein Problem richtig erklären:
Ich habe ein Datenbestand, der sieht so aus:
A_______B______C_______D_______E_______F_______G_______H_______I________
CE______Gross___klein____Text1____Text2___100,-____200,-____LEER____BUS______
CE______Gross___klein____Text1____Text2___200,-____100,-____LEER____BUS______
CE______Gross___klein____Text1____Text2___150,-____400,-____LEER____BUS______
WS______Gross___klein____Text1____Text2___120,-____200,-____LEER____BAHN______
WS______Gross___klein____Text1____Text2___180,-____500,-____LEER____BAHN______
CD______Gross___klein____Text1____Text2___100,-____200,-____LEER____ZUG______
PS: Spalte H ist leer.
Ich möchte nun folgendes erreichen: mit einem Makro möchte ich die Spalte I ab Zeile 10 bis zum Ende der Datensätze durchlaufen. Es soll geprüft werden, ob in I gleiche STRINGS vorkommen, wenn ja, sollen diese gleiche Datensätze zu einem zusammen gefasst werden. Heisst, aus:
A_______B______C_______D_______E_______F_______G_______H_______I________
CE______Gross___klein____Text1____Text2___100,-____200,-____LEER____BUS______
CE______Gross___klein____Text1____Text2___200,-____100,-____LEER____BUS______
CE______Gross___klein____Text1____Text2___150,-____400,-____LEER____BUS______
soll
A_______B______C_______D_______E_______F_______G_______H_______I________
CE______Gross___klein____Text1____Text2___450,-____700,-____LEER____BUS______
werden.
Also aus zB diesen drei Datensätze (BUS) soll einer gemacht werden und die Geldbeträge in der Spalte F und G sollen addiert werden.
Im Prinziep könnten dann die beiden anderen Datensätze gelöscht werden, dass nur noch der DS mit der Gesammtsumme da steht.
So sollen alle Datensätze in I durchlaufen werden und bei Bedarf die Datensätze zusammen gefasst werden.
könnte mir da jemand mit einem Makro weiterhelfen, wäre echt nett.
Danke
Kai

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Mehrere Datensätze zusammenfassen
13.01.2011 16:35:00
Tino
Hallo,
kannst mal diesen Code testen.
Ich gehe davon aus, dass die Tabelle eine Überschrift hat.
Die Tabelle noch anpassen.
Sub Filter_()
Dim MaxRow As Long, MinRow As Long
Dim oWS As Worksheet

Set oWS = Tabelle1 'Tabelle anpassen 

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    
        With oWS.UsedRange
            With .Columns(.Columns.Count).Offset(0, 1).Resize(, 4)
                MaxRow = .Cells(.Rows.Count, 1).Row
                MinRow = .Cells(1, 1).Row + 1
                .Columns(1).FormulaR1C1 = _
                    "=CONCATENATE(RC1,""-"",RC2,""-"",RC3,""-"",RC4,""-"",RC5,""-"",RC9)"
                
                .Columns(2).FormulaR1C1 = _
                    "=IF(COUNTIF(RC[-1]:R" & MaxRow & "C[-1],RC[-1])=1,SUMIF(R" & MinRow & "C[-1]:R" & MaxRow & "C[-1],RC[-1],R" & MinRow & "C6:R" & MaxRow & "C6),0)"
                    
                .Columns(3).FormulaR1C1 = _
                "=IF(COUNTIF(RC[-2]:R" & MaxRow & "C[-2],RC[-2])=1,SUMIF(R" & MinRow & "C[-2]:R" & MaxRow & "C[-2],RC[-2],R" & MinRow & "C7:R" & MaxRow & "C7),0)"
                
                .Columns(4).FormulaR1C1 = "=IF(OR(AND(COUNTIF(RC[-3]:R" & MaxRow & "C[-3],RC[-3])=1,RC[-3]<>""-----""),ROW()<" & MinRow & "),ROW(),TRUE)"
                
                oWS.Range(oWS.Cells(MinRow, 6), oWS.Cells(MaxRow, 7)).Value = oWS.Range(.Cells(2, 2), .Cells(MaxRow, 3)).Value
                
                oWS.UsedRange.Sort .Cells(1, 4), Order1:=xlAscending, Header:=xlYes
                
                On Error Resume Next
                    .Columns(4).SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
                    .EntireColumn.Delete
                On Error GoTo 0
            End With
        End With

    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With
End Sub
Gruß Tino
Anzeige
Danke beide, funktioniert, kurze Nachfrage:
13.01.2011 22:53:07
Kai
Hallo Christian oder Tino,
Beide Codes funktioniere klasse, Danke. Noch eine kurze Frage:
Ich es möglich, die Anzahl der zusammengefassten Datensätze zu zählen. Also, dass wenn das makro zB in der Spalte I zwei oder mehrere gleiche Strings befindet, die Anzahl der gleichen Strings zum Beispiel in die Leere Spalte H schreibt.
Hier noch mal das Beispiel:
A_______B______C_______D_______E_______F_______G_______H_______I________
CE______Gross___klein____Text1____Text2___100,-____200,-____LEER____BUS______
CE______Gross___klein____Text1____Text2___200,-____100,-____LEER____BUS______
CE______Gross___klein____Text1____Text2___150,-____400,-____LEER____BUS______
und dass dann als Ergebnis in der Spalte H zum Beispiel hier eine "3" steht:
A_______B______C_______D_______E_______F_______G_______H_______I________
CE______Gross___klein____Text1____Text2___450,-____700,-____3_______BUS______
So könnte ich an den übrig gebliebenen datensätzen erkenne, "diese Zeile wurde ursprünglich aus 3 Datensätze gebildet"
So könnte ich auch bei einer grossen Anzahl auch gleich auf einen Blick sehen, da wo überall einje Zahl drin steht, wurde an den daten was geändert.
Wäre das noch möglich ?
Bis dahin auf jeden Fall vielen dank für die Guten Beispiel
Gruß
Kai
Anzeige
AW: Mehrere Datensätze zusammenfassen
13.01.2011 17:03:27
Christian
Hallo Kai,
ein Vorschlag für Tabelle1 - Name ggf. anpassen.
Die Einträge der Zeilen 10 bis letzte Zeile mit Eintrag in Spalte I werden gelöscht.
gruß
Christian
Option Explicit
Sub TestData()
Dim hsh As Object
Dim i&, lngLR&
Dim strType$, vnt
Set hsh = CreateObject("Scripting.Dictionary")
With Sheets("Tabelle1")
lngLR = .Cells(.Rows.Count, 9).End(xlUp).Row
For i = 10 To lngLR
strType = .Cells(i, 9).Text
If hsh.Exists(strType) Then
vnt = hsh(strType)
vnt(1, 6) = vnt(1, 6) + .Cells(i, 6).Value
vnt(1, 7) = vnt(1, 7) + .Cells(i, 7).Value
hsh(strType) = vnt
Else
hsh(strType) = .Cells(i, 1).Resize(, 9).Value
End If
Next
i = 10
.Rows(10).Resize(lngLR - 9).ClearContents
For Each vnt In hsh.Items
.Cells(i, 1).Resize(, 9) = vnt
i = i + 1
Next
End With
Set hsh = Nothing
End Sub

Anzeige
Danke beide, funktioniert, kurze Nachfrage:
13.01.2011 22:50:55
Kai
Hallo Christian oder Tino,
Beide Codes funktioniere klasse, Danke. Noch eine kurze Frage:
Ich es möglich, die Anzahl der zusammengefassten Datensätze zu zählen. Also, dass wenn das makro zB in der Spalte I zwei oder mehrere gleiche Strings befindet, die Anzahl der gleichen Strings zum Beispiel in die Leere Spalte H schreibt.
Hier noch mal das Beispiel:
A_______B______C_______D_______E_______F_______G_______H_______I________
CE______Gross___klein____Text1____Text2___100,-____200,-____LEER____BUS______
CE______Gross___klein____Text1____Text2___200,-____100,-____LEER____BUS______
CE______Gross___klein____Text1____Text2___150,-____400,-____LEER____BUS______
und dass dann als Ergebnis in der Spalte H zum Beispiel hier eine "3" steht:
A_______B______C_______D_______E_______F_______G_______H_______I________
CE______Gross___klein____Text1____Text2___450,-____700,-____3_______BUS______
So könnte ich an den übrig gebliebenen datensätzen erkenne, "diese Zeile wurde ursprünglich aus 3 Datensätze gebildet"
So könnte ich auch bei einer grossen Anzahl auch gleich auf einen Blick sehen, da wo überall einje Zahl drin steht, wurde an den daten was geändert.
Wäre das noch möglich ?
Bis dahin auf jeden Fall vielen dank für die Guten Beispiel
Gruß
Kai
Anzeige
AW: Danke beide, funktioniert, kurze Nachfrage:
14.01.2011 09:32:37
Christian
so z.B:
Sub TestData()
Dim hsh As Object
Dim i&, lngLR&
Dim strType$, vnt
Set hsh = CreateObject("Scripting.Dictionary")
With Sheets("Tabelle1")
lngLR = .Cells(.Rows.Count, 9).End(xlUp).Row
For i = 10 To lngLR
strType = .Cells(i, 9).Text
If hsh.Exists(strType) Then
vnt = hsh(strType)
vnt(1, 6) = vnt(1, 6) + .Cells(i, 6).Value
vnt(1, 7) = vnt(1, 7) + .Cells(i, 7).Value
vnt(1, 10) = vnt(1, 10) + 1
hsh(strType) = vnt
Else
vnt = .Cells(i, 1).Resize(, 10).Value
vnt(1, 10) = 1
hsh(strType) = vnt
End If
Next
i = 10
.Rows(10).Resize(lngLR - 9).ClearContents
For Each vnt In hsh.Items
.Cells(i, 1).Resize(, 10) = vnt
i = i + 1
Next
End With
Set hsh = Nothing
End Sub

Gruß
Christian
Anzeige
AW: Danke , passt :-)
14.01.2011 15:35:03
Kai

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige