Durchsuchen eines Arbeitsblattes und Wiedergabe der ersten Spalte

[rhs]

Hallo zusammen,

als erstes Entschuldigung, falls diese Frage schon in einem anderen Thread behandelt wurde, ich hab jedoch für mich keine direkte Hilfe ableiten können.

Zu meinem Problem. Ich habe eine Excel Arbeitsmappe übernommen, die in der Form weitergepflegt und erweitert werden soll. In dieser Arbeitsmappe befinden sich 2 Arbeitspblätter (aus denen weitere Auswertungen in anderen Tabellen gezogen werden).

So sehen die Tabellen mit den mehr oder weniger relevanten Spalten aus.

Arbeitsblatt 1:

Tabelle1

	A	B	C	D	E	F
1	Mitarbeiter	Standort	Device 1	Device 2	Device 3	Device 4
2	Max Mustermann	Musterhausen	SN123		SN456	SN555
3	Maxi Musterfrau	Musterhausen	SN744	SN789		SN555
4	Maxim Musterman	Musterdorf	SN444	SN885	SN658	SN555
5	Maxima Musterfrau	Musterdorf				SN555

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8

Arbeitsblatt 2:

Tabelle2

	A	B	C	D
1	Device	Seriennummer	Preis	Mitarbeiter
2	Device 1	SN123	10,00 €
3	Device 1	SN744	10,00 €
4	Device 1	SN444	11,00 €
5	Device 2	SN789	20,00 €
6	Device 2	SN885	25,00 €
7	Device 3	SN456	13,00 €
8	Device 3	SN658	13,00 €
9	Device 4	SN555	111,00 €

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8

Was genau soll nun passieren?

Die Spalte Mitarbeiter in Arbeitsblatt 2 soll mit den Daten aus Arbeitsblatt 1 befüllt werden. Dafür soll Arbeitsblatt 1 nach der Seriennummer (Arbeitsblatt 2, Spalte B) durchsucht werden und wenn die Seriennummer gefunden wird, soll der Mitarbeitername (aus Arbeitsblatt 1, Spalte 1) eingetragen werden. Wenn eine Seriennummer mehreren Mitarbeitern zugeordnet ist, dann sollten die Namen mit Komma getrennt in die Spalte eingetragen werden - sofern das möglich ist.

Ich bin leider auf keinen Grünen Zweig gekommen und schwanke zwischen #NV und Excelabsturz.

Ich bin für jede Hilfe dankbar!

Viele Grüße
rhs

[Crazy Tom]

Hallo

eine Möglichkeit
zu starten aus Tabelle2

Code:

Sub test()
   Dim c As Range
   Dim strFirst As String
   Dim i As Long
   Dim strErgebnis As String
   Dim strEintrag As String
   With Sheets("Tabelle1")
       For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
           Set c = .Cells.Find(Cells(i, 2).Value, LookIn:=xlValues, lookat:=xlWhole)
           If Not c Is Nothing Then
               strFirst = c.Address
               Do
                   strErgebnis = .Cells(c.Row, 1).Value
                   strEintrag = strEintrag & "," & strErgebnis
                   Set c = .Cells.FindNext(c)
               Loop While Not c Is Nothing And c.Address <> strFirst
               Cells(i, 4).Value = strEintrag
           End If
           strEintrag = ""
       Next
   End With
End Sub

MfG Tom

[neopa]

Hallo,

wenn es keine Massendatenverarbeitung werden soll (also möglichst weniger als 1000 Datensätze) und Du kein Problem in Hilfsspalten in Tabelle 2 ab Spalte E siehst (kannst Du abschließend auch ausblenden) dann mit folgender Matrixfunktion(alität)sformel, die jedoch keines spez. Formelabschluss wie eine klassische Matrixformel benötigt in D2:

=WENNFEHLER(INDEX(Tabelle1!$A:$A;AGGREGAT(15;6;ZEILE(A$2:A$99)/(Tabelle1!$C$2:$F$99=$B2)/($B2>0);SPALTE(A2)))&WENN(E2="";"";", "&ZEICHEN(10)&E2);"")

Formel weit genug nach rechts (min. soweit wie eine Seriennummer max verschiedenen Namen zugewiesen ist, im Beispiel sind es 4 also da bis Spalte G) und anschließend komplett nach unten ziehend kopieren.

In Spalte G das Format für Textsteuerung auf Zeilenumbruch umstellen.

[rhs]

Hallo

eine Möglichkeit
zu starten aus Tabelle2

Code:

Sub test()
   Dim c As Range
   Dim strFirst As String
   Dim i As Long
   Dim strErgebnis As String
   Dim strEintrag As String
   With Sheets("Tabelle1")
       For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
           Set c = .Cells.Find(Cells(i, 2).Value, LookIn:=xlValues, lookat:=xlWhole)
           If Not c Is Nothing Then
               strFirst = c.Address
               Do
                   strErgebnis = .Cells(c.Row, 1).Value
                   strEintrag = strEintrag & "," & strErgebnis
                   Set c = .Cells.FindNext(c)
               Loop While Not c Is Nothing And c.Address <> strFirst
               Cells(i, 4).Value = strEintrag
           End If
           strEintrag = ""
       Next
   End With
End Sub

MfG Tom

Hallo Tom,

Ich habe dein Skript getestet und es füllt alles aus, allerdings scheint das Makro immer weiter zu laufen und kein Ende zu finden. Ich musste am Ende Excel per Taskmanager beenden :(

Hallo,

wenn es keine Massendatenverarbeitung werden soll (also möglichst weniger als 1000 Datensätze) und Du kein Problem in Hilfsspalten in Tabelle 2 ab Spalte E siehst (kannst Du abschließend auch ausblenden) dann mit folgender Matrixfunktion(alität)sformel, die jedoch keines spez. Formelabschluss wie eine klassische Matrixformel benötigt in D2:

=WENNFEHLER(INDEX(Tabelle1!$A:$A;AGGREGAT(15;6;ZEILE(A$2:A$99)/(Tabelle1!$C$2:$F$99=$B2)/($B2>0);SPALTE(A2)))&WENN(E2="";"";", "&ZEICHEN(10)&E2);"")

Formel weit genug nach rechts (min. soweit wie eine Seriennummer max verschiedenen Namen zugewiesen ist, im Beispiel sind es 4 also da bis Spalte G) und anschließend komplett nach unten ziehend kopieren.

In Spalte G das Format für Textsteuerung auf Zeilenumbruch umstellen.

Hallo neopa,

Hilfspalten sind kein Problem und ich habe deine Formel an meine Tabelle angepasst. Da die Tabelle mehrere Hundert Zeilen und sicher 30 Spalten beinhaltet, stoße ich auf ähnliche Probleme wie bei Crazy Tom, nur das Excel hier gleich Die Ressourcenkeule schwingt und sagt, dass er die Formel nicht bearbeiten kann. :(



Vielen Dank an euch beide für die Arbeit!