Microsoft Excel

Herbers Excel/VBA-Archiv

Zeilen zusammenfügen / konsolidieren

Betrifft: Zeilen zusammenfügen / konsolidieren von: Volker
Geschrieben am: 21.04.2007 10:25:53

Hallo

Habe eine recht grosse Tabelle in der Form

Kunde1 Haus1 Produkt1
Kunde1 Haus1 Produkt2
Kunde1 Haus1 Produkt3
Kunde1 Haus2 Produkt2
Kunde2 Haus1 Produkt2
Kunde2 Haus1 Produkt4
Kunde2 Haus3 Produkt2
Kunde3 Haus3 Produkt1
usw

Die Daten in den Zeilen sollen nun konsolidiert werden, die Häuser und Produkte je Kunde in jeweils nur einer Zelle stehen, also dann später so aussehen:

Kunde1 Haus1,Haus2 Produkt1,Produkt2,Produkt3
Kunde2 Haus1 Produkt2,Produkt4
Kunde3 Haus3 Produkt1

Gibt es dafür eine Lösung mit Excel 2003 oder Excel 2007 ??

Viele Grüsse
Volker

  

Betrifft: AW: Zeilen zusammenfügen / konsolidieren von: ransi
Geschrieben am: 22.04.2007 09:39:12

Hallo Volker

Füge diesen Code mal in ein Modul in deiner Mappe ein:

Option Explicit

Public Function SVERWEIS2(Kriterium As String, Bereich As Range, SuchSpalte As Integer, ErgebnissSpalte As Integer, Optional Trenner As String = ", ") As String
Dim arrTmp
Dim L As Long
arrTmp = Bereich
For L = 1 To UBound(arrTmp)
    If arrTmp(L, SuchSpalte) = Kriterium Then _
        If InStr(1, SVERWEIS2, arrTmp(L, ErgebnissSpalte)) = 0 Then _
        SVERWEIS2 = SVERWEIS2 & arrTmp(L, ErgebnissSpalte) & Trenner
Next
SVERWEIS2 = Left(SVERWEIS2, Len(SVERWEIS2) - Len(Trenner))
End Function


Der Aufruf in einer Tabelle geht dann so:

Tabelle1

 ABCDEF
1KundeHausProdukt Kunde 
2Kunde1Haus1Produkt1 Kunde1Haus1, Haus2, Produkt1, Produkt2, Produkt3
3Kunde1Haus1Produkt2 Kunde2Haus1, Haus3, Produkt2, Produkt4
4Kunde1Haus1Produkt3 Kunde3Haus3, Produkt1
5Kunde1Haus2Produkt2   
6Kunde2Haus1Produkt2   
7Kunde2Haus1Produkt4   
8Kunde2Haus3Produkt2   
9Kunde3Haus3Produkt1   
10      

Formeln der Tabelle
ZelleFormel
F2=SVERWEIS2(E2;A:C;1;2)&", " &SVERWEIS2(E2;A:C;1;3)
F3=SVERWEIS2(E3;A:C;1;2)&", " &SVERWEIS2(E3;A:C;1;3)
F4=SVERWEIS2(E4;A:C;1;2)&", " &SVERWEIS2(E4;A:C;1;3)


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4

Reicht dir das so ?


ransi


  

Betrifft: AW: Zeilen zusammenfügen / konsolidieren von: Volker
Geschrieben am: 22.04.2007 11:28:15

Hallo ransi

Klasse !! Vom Prinzip her klappt es, ich habe die "SVERWEIS2" wegen der Übersichtlichkeit auf F2 und G2 aufgeteilt.

Das Ganze läuft aber nicht mit der ganzen Tabelle, die ca. 45000 Zeilen hat.
Wo genau die Zeilengrenze ist kann ich nicht sagen. Jedenfalls bis 21000 Zeilen läuft es tadellos,
ab 25000 Zeilen erhalte ich dann in dann in sämtlichen Feldern der Spalten F und G nur WERT#-Fehler.

Liegt das am Arbeitsspeicher oder ist eine der Befehle/Variablen begrenzt ?

Dramatisch ist das nicht, denn ich kann die Gesamttabelle teilen und dann die Ergebnisse zusammenfügen.

Wirklich ganz herzlich Dank !

Volker


  

Betrifft: AW: Zeilen zusammenfügen / konsolidieren von: ransi
Geschrieben am: 22.04.2007 12:30:49

HAllo Volker

Ich weiss nicht was da klemmt.
Bei mir funzt das über komplette Spalten.

Bevor ich einen ganz anderen Ansatz verfolge, teste mal bitte diesen Code:

Public Sub test()
Dim arr
Set arr = CreateObject("System.Collections.Arraylist")
Set arr = Nothing
End Sub



Kommt da eine Fehlermeldung bei dir ?

ransi


  

Betrifft: AW: Zeilen zusammenfügen / konsolidieren von: Erich G.
Geschrieben am: 22.04.2007 11:39:23

Hallo Volker,
versuchs mal mit diesem Code:

Option Explicit

Sub Kunde_Zeile()
   Dim lngQ As Long, arrQ(), zQ As Long, zZ As Long, ii As Integer
   Dim colH As New Collection, colP As New Collection, arrZ(1 To 3) As String
   
   lngQ = Cells(Rows.Count, 1).End(xlUp).Row
   ReDim arrQ(1 To lngQ, 1 To 3)
   arrQ = Range(Cells(1, 1), Cells(lngQ, 3)).Value    ' Daten aus Bereich holen
'  Call prcSort(Array(1), arrQ())      ' falls nötig: ' Sortieren nach Kunden (Sp. 1)
   zZ = lngQ + 3

   For zQ = 1 To UBound(arrQ)
      If arrZ(1) <> arrQ(zQ, 1) Then                  ' wenn neuer Kunde
         If zQ > 1 Then GoSub EINTRAG              ' vorigen Kunden eintragen
         arrZ(1) = arrQ(zQ, 1)                     ' neue Zeile beginnen
      End If
      On Error Resume Next
      colH.Add arrQ(zQ, 2), arrQ(zQ, 2)   ' ohne Dubletten bei Haus
      colP.Add arrQ(zQ, 3), arrQ(zQ, 3)   ' ohne Dubletten bei Produkt
      On Error GoTo 0
   Next zQ
EINTRAG:
   If colH.Count > 0 Then arrZ(2) = colH(1) Else arrZ(2) = ""
   For ii = 2 To colH.Count
      arrZ(2) = arrZ(2) & "," & colH(ii)
   Next ii
   If colP.Count > 0 Then arrZ(3) = colP(1) Else arrZ(3) = ""
   For ii = 2 To colP.Count
      arrZ(3) = arrZ(3) & "," & colP(ii)
   Next ii
   Set colH = New Collection
   Set colP = New Collection
   zZ = zZ + 1
   Range(Cells(zZ, 1), Cells(zZ, 3)) = arrZ
   If zQ <= UBound(arrQ) Then Return
End Sub

  

Betrifft: AW: Problem gelöst? (oT) von: Erich G.
Geschrieben am: 24.04.2007 23:19:58




 

Beiträge aus den Excel-Beispielen zum Thema "Zeilen zusammenfügen / konsolidieren"