Frage zu: AW: Suchergebnis zusammengefasst dargestellt - von Christian am 28.01.2020 22:52:46
29.01.2020 15:14:55
Christian
Ich hatte gestern unten stehend Beitrag angefragt und Chrstian hat mir geantwortet.
Jedoch kann ich auf die Anwort von Christian nicht anworten, mache ich da was falsch?
Somit versuche ich Christian nun mit diesem neuen Beitrag noch zu erreichen:
@ Christina: Danke für Dein Script, funktioniert sehr gut.
Eine Frage habe ich noch.
Wäre es möglich, dass eine Nummernzuweisung nur 1x aufgelistet wird, wie müsste Dein Scrip angepasst werden, damit die Nummern in einer Zelle jeweils nur 1x aufgeführt wird?
-------------------------------------------------------------------------------------------------------------------------------------
Meine Anfrage vom:
Geschrieben am: 28.01.2020 15:28:36
Hallo zusammen
Ich suche eine VBA-Lösung die mir die Suchergebnisse, entsprechend dem Suchkriterium jeweils in einer Zelle zusammengefasst anzeigt.
In der Tabelle 1, Spalte A2:A stehen Auftragsnummern, die nur 1x oder mehrfach vorkommen können.
In der Spalte B2:B stehen Nummern die jeweils einer oder mehrere Auftragsnummern zugewiesen sind.
Eine Auftragsnummer kann mehrere Nummern zugewiesen haben.
In der Tabelle 2 sollen entsprechend der Auftragsnummer (A2:A) + Index (B2:B) jeweils alle Nummernzuweisungen der Tabelle 1 zusammen gefasst dargestellt werden.
Wenn eine Auftragsnummer der Tabelle 2 in der Tabelle 1 nicht gefunden wird, dann soll anstelle der Nummerzuweisungen "na" stehen.
Könnt Ihr mir damit helfen, hat jemand eine Idee wie man das in VBA umsetzen könnte?
Testdatei: https://www.herber.de/bbs/user/134792.xlsm
Danke für Eure Hilfe.
Viele Grüsse,
Peter
-------------------------------------------------------------------------------------------------------------------------------------
Antwort von Chrstian:
Hallo Peter,
so z.B.
Option Explicit
Sub TestIt()
Dim objDic As Object
Dim i As Long, lngNum As Long, lngLR As Long
Set objDic = CreateObject("Scripting.Dictionary")
With ThisWorkbook.Sheets("Tabelle1")
For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
lngNum = .Cells(i, 1)
If objDic.Exists(lngNum) Then
objDic(lngNum) = objDic(lngNum) & ", " & .Cells(i, 2)
Else
objDic(lngNum) = .Cells(i, 2)
End If
Next
End With
With ThisWorkbook.Sheets("Tabelle2")
lngLR = .Cells(.Rows.Count, 1).End(xlUp).Row
.Cells(2, 3).Resize(lngLR - 1).ClearContents
For i = 2 To lngLR
lngNum = .Cells(i, 1)
If objDic.Exists(lngNum) Then
.Cells(i, 3) = objDic(lngNum)
Else
.Cells(i, 3) = "na"
End If
Next
End With
Set objDic = Nothing
End Sub
Vielen Dank und
viele Grüsse,
Peter