Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Zeilen durchsuchen und in Zellen zusammenfassen

Zeilen durchsuchen und in Zellen zusammenfassen
26.07.2018 09:39:33
Volker
Hallo zusammen,
ich würde gerne die einer Dok Nr zugeordneten Werte in einer Zelle zusammenfassen und Dok.Nr. sortiert auflisten lassen (siehe Anhang)
Vorab vielen Dank für Eure Hilfe!!!
https://www.herber.de/bbs/user/122902.xlsx
Anzeige

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

Betreff
Datum
Anwender
Anzeige
AW: Zeilen durchsuchen und in Zellen zusammenfassen
26.07.2018 09:53:11
Michael
Hallo!
Eine Darstellung in einer PivotTabelle (die in diesem Fall vielleicht 5 Mausklicks benötigt) reicht Dir nicht?
Userbild
Dazu eine PivotTabelle auf die erste Tabelle beziehen und DokNr und Werte in die Zeilenbeschriftung ziehen.
LG
Michael
Anzeige
AW: Zeilen durchsuchen und in Zellen zusammenfassen
26.07.2018 12:10:56
Volker
Hallo Michael,
danke für deinen Tip, aber ich benötige die zugeordneten KKS Nr. (zwecks Export in eine Datenbank) in einer Zelle jeweils durch "; " getrennt!
Gruß
Volker
AW: Per Makro so...
26.07.2018 13:35:22
Michael
Hallo!
Unter der Annahme, dass sowohl "Tabelle1" als auch "Tabelle2" bereits in der Mappe existieren und (idF) "Tabelle2" noch leer ist:
Sub a()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1")
Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle2")
Dim Dic As Object, aIn, aOut(), i&, j&, k
Application.ScreenUpdating = False
Set Dic = CreateObject("Scripting.Dictionary")
With WsQ
aIn = .Range(.Cells(2, 1), .Cells(.Rows.Count, 2).End(xlUp))
For i = LBound(aIn, 1) To UBound(aIn, 1)
If Not Dic.exists(aIn(i, 2)) Then
Dic.Add aIn(i, 2), aIn(i, 1) & "; "
Else:
Dic(aIn(i, 2)) = Dic(aIn(i, 2)) & aIn(i, 1) & "; "
End If
Next i
End With
ReDim aOut(1 To Dic.Count, 1 To 2)
For Each k In Dic.keys
j = j + 1: aOut(j, 1) = k: aOut(j, 2) = Dic(k)
Next k
With WsZ
.Range(.Cells(2, 1), .Cells(UBound(aOut, 1) + 1, 2)) = aOut
End With
Set Wb = Nothing: Set WsQ = Nothing: Set WsZ = Nothing
Set Dic = Nothing: Erase aIn: Erase aOut
End Sub
Passt?
LG
Michael
Anzeige
AW: Per Makro so...
26.07.2018 14:13:07
Volker
Hi Michael,
passt perfekt!
VIELEN DANK!!!
Gruß Volker
Gern, freut mich! Danke für die Rückmeldung, owT
26.07.2018 14:32:27
Michael
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige