Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1632to1636
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

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

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

311 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige