Auflistung

Forumthread: Auflistung

Auflistung

25.05.2018 16:05:47

Rene

Guten Tag,
ich benötige für eine Tabelle mit 10 tsd Zeilen eine Lösung bei einer Auflistung.
In Spalte A stehen Artikelnummer und in Spalte B stehen Gerätetypen.
Nun gibt es Artikelnummern (Spalte A) die für mehrere Geräte (Spalte B) verwendet werden können.
Ich suche also eine Formel, die die Geräte aus Spalte B der jeweiligen Artikelnummer aus Spalte A zuordnet und zwar in der Form "Gerät1,Gerät2,Gerät3".
Gibt es dafür eine Lösung?
Zu Anschauung habe ich eine Mustertabelle angehangen.
https://www.herber.de/bbs/user/121827.xlsx
Für jegliche Mühe hierzu möchte ich mich bereits jetzt bedanken.
Rene

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Auflistung

25.05.2018 16:51:30

UweD
AW: Auflistung

25.05.2018 17:59:52

Barbaraa
AW: Auflistung

25.05.2018 17:42:26

Barbaraa

AW: Auflistung

25.05.2018 16:51:30

UweD

Hallo
Formel, hab ich keine aber eine VBA Lösung
in ein Modul

Sub Geräte()
    Dim Tb, LR As Double, Sp1 As Integer, Sp2 As Integer, SpZ As Integer, i As Double
    Dim c As Range, firstAddress As String
    
    '*** 
    Set Tb = Sheets("Tabelle1")
    Sp1 = 1 ' Spalte A 
    Sp2 = 2 ' Spalte B 
    SpZ = 3 ' Zielspalte 
    '*** 
    
    
    'Reset 
    Tb.Columns(SpZ).ClearContents
    
    
    
    LR = Tb.Cells(Tb.Rows.Count, Sp1).End(xlUp).Row 'letzte Zeile der Spalte 
        
    For i = 2 To LR
        Set c = Tb.Columns(Sp1).Find(Tb.Cells(i, Sp1), LookIn:=xlValues) 'Suchen in erster Spalte 
        If Not c Is Nothing Then
        
            firstAddress = c.Address 'merken Zelle erster Fund 
            
            Do
                'Text zusammenbauen 
                With Tb.Cells(i, SpZ)
                    .Value = .Value & c.Offset(0, 1) & ","
                End With
                Set c = Tb.Columns(Sp1).FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
            
            'letztes Komma weg 
            With Tb.Cells(i, SpZ)
                .Value = Left(.Value, Len(.Value) - 1)
            End With
            
        End If
    Next
End Sub

LG UweD

AW: Auflistung

25.05.2018 17:59:52

Barbaraa

Uwe, mir ist aufgefallen, dass wir unterschiedliche Ergebnisse liefern.
Dein Code versagt, wenn in Zellen in Spalte A Inhalte in anderen Inhalten vorkommen.
Wenn Du zum Beispiel nach "111" suchst, wird auch bei "61116456456" ein Fund gemeldet.
Abhilfe schafft ", LookAt:=xlWhole" im Find.
LGB

AW: Auflistung

25.05.2018 17:42:26

Barbaraa

Probier mal

Sub Zusammenfassung()
Dim rAAA As Range, rBBB As Range
Dim rSpalteA As Range
With ActiveSheet
Set rSpalteA = .Range("A2", "A" & .Range("A2").End(xlDown).Row)
End With
rSpalteA.Offset(0, 2).Clear
For Each rAAA In rSpalteA
For Each rBBB In rSpalteA
If rAAA = rBBB Then
rBBB.Offset(0, 2) = rBBB.Offset(0, 2) & rAAA.Offset(0, 1) & ","
End If
Next rBBB
Next rAAA
For Each rAAA In rSpalteA
If rAAA.Offset(0, 2)  "" Then
rAAA.Offset(0, 2) = Left(rAAA.Offset(0, 2), Len(rAAA.Offset(0, 2)) - 1)
End If
Next rAAA
End Sub

Hilft das?
LGB

Beliebteste Forumthreads (12 Monate)

Forumthread: Auflistung

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread