Microsoft Excel

Herbers Excel/VBA-Archiv

Datenkonsolidierung in Pivot-Tabelle

Betrifft: Datenkonsolidierung in Pivot-Tabelle von: Sebastian
Geschrieben am: 01.10.2014 12:40:01

Hallo zusammen,

ich habe aus unserem CRM System einen Export mit den folgenden Spalten:
Projekt; Kunde; Lieferant

Dabei gilt:
- Ein Kunde kann mehrere Projekte haben
- Ein Projekt kann mehrere Lieferanten haben
- Die Anzahl der Lieferanten pro Projekt variiert

Ich habe pro Kunde-Projekt-Lieferant-Beziehung eine Zeile in meinem Export. Ich würde diese Informationen gerne zusammenfassen, sodass ich nur eine Zeile pro Projekt mit folgenden Spalten habe:
"Projekt A"; "Kunde Balblubb"; "Lieferant 1, Lieferant 2, ..."

Wobei hier die Lieferanten in einer Zelle zusammengefasst und mit Kommata getrennt aufgeführt werden sollen.

Ich habe jetzt eine Weile mit einer Pivot-Tabelle experimentiert, bekomme dieses Layout allerdings nur mit der Summe der Lieferanten hin. Besteht die Möglichkeit die Lieferanten in einer Zelle zusammenzusetzen?

Beispieldatei unter: https://www.herber.de/bbs/user/92927.xlsx

Viele Grüße
Sebastian

  

Betrifft: AW: Datenkonsolidierung in Pivot-Tabelle von: fcs
Geschrieben am: 01.10.2014 18:34:02

Hallo Sebastian,

ein Pivotbericht kann dies nicht leisten.
Wenn man die Liste nach Projekt,und Kund sortiert, dann kann man mit etwas Geschickt und 2 Zusatzspalten per Formel und Filter ein Ergebnis erzielen.

Ich persönlich bevorzuge hier eine Makrolösung.

Gruß
Franz

Sub ProKndLieferanten_2()
  Dim arrData As Variant, Zeile As Long, Zeile2 As Long
  Dim bolErledigt As Boolean
  Dim arrErgebnis() As String, intErgebnis
  Dim strProj As String, strKnd As String, strLief As String
  
  'Ausgangsdaten aus A2 bis Cxxx in Array einlesen
  With ActiveSheet
    arrData = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 2))
  End With
  
  'Ausgangsdaten zeilenweise abarbeiten
  For Zeile = LBound(arrData, 1) To UBound(arrData, 1)
      strProj = arrData(Zeile, 1)
      strKnd = arrData(Zeile, 2)
      strLief = arrData(Zeile, 3)
      bolErledigt = False
      If intErgebnis > 0 Then
        'Daten mit Ergebnis-Array vergleichen
        For Zeile2 = LBound(arrErgebnis, 2) To UBound(arrErgebnis, 2)
            If strProj = arrErgebnis(1, Zeile2) Then
              If strKnd = arrErgebnis(2, Zeile2) Then
                arrErgebnis(3, Zeile2) = arrErgebnis(3, Zeile2) & ", " & strLief
                bolErledigt = True
                Exit For
              End If
            End If
        Next
      End If
      If bolErledigt = False Then
        'neuen Datensatz (Projekt) im Ergebnis-Array anlegen
        intErgebnis = intErgebnis + 1
        ReDim Preserve arrErgebnis(1 To 3, 1 To intErgebnis)
        arrErgebnis(1, intErgebnis) = strProj
        arrErgebnis(2, intErgebnis) = strKnd
        arrErgebnis(3, intErgebnis) = strLief
      End If
  Next
  'Ergebnisdaten in neuem Blatt eintragen
  ActiveWorkbook.Worksheets.Add after:=ActiveSheet
  With ActiveSheet
    .Cells(1, 1) = "Projekt"
    .Cells(1, 2) = "Kunde"
    .Cells(1, 3) = "Lieferanten"
    .Cells(2, 1).Resize(intErgebnis, 3) = Application.WorksheetFunction.Transpose(arrErgebnis)
  End With
End Sub