Zeilen zusammenfügen / konsolidieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

	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

Zelle	Formel
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

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

Beliebteste Forumthreads (12 Monate)

Zeilen zusammenfügen / konsolidieren

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread