Herbers Excel/VBA-Archiv
Zeilen zusammenfügen / konsolidieren
- Zeilen zusammenfügen / konsolidieren von Volker vom 21.04.2007 10:25:53
- AW: Zeilen zusammenfügen / konsolidieren - von ransi am 22.04.2007 09:39:12
- AW: Zeilen zusammenfügen / konsolidieren - von Volker am 22.04.2007 11:28:15
- AW: Zeilen zusammenfügen / konsolidieren - von ransi am 22.04.2007 12:30:49
- AW: Zeilen zusammenfügen / konsolidieren - von ransi am 22.04.2007 12:30:49
- AW: Zeilen zusammenfügen / konsolidieren - von Volker am 22.04.2007 11:28:15
- AW: Zeilen zusammenfügen / konsolidieren - von Erich G. am 22.04.2007 11:39:23
- AW: Problem gelöst? (oT) - von Erich G. am 24.04.2007 23:19:58
 |
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:
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
| A | B | C | D | E | F | |
| 1 | Kunde | Haus | Produkt | Kunde | ||
| 2 | Kunde1 | Haus1 | Produkt1 | Kunde1 | Haus1, Haus2, Produkt1, Produkt2, Produkt3 | |
| 3 | Kunde1 | Haus1 | Produkt2 | Kunde2 | Haus1, Haus3, Produkt2, Produkt4 | |
| 4 | Kunde1 | Haus1 | Produkt3 | Kunde3 | Haus3, Produkt1 | |
| 5 | Kunde1 | Haus2 | Produkt2 | |||
| 6 | Kunde2 | Haus1 | Produkt2 | |||
| 7 | Kunde2 | Haus1 | Produkt4 | |||
| 8 | Kunde2 | Haus3 | Produkt2 | |||
| 9 | Kunde3 | Haus3 | Produkt1 | |||
| 10 |
| Formeln der Tabelle | ||||||||
|
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:
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"