In Spalte suchen und dazugehörige Werte ausgeben

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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 Art As Range, c As Range, List As Range, f As Range Application.ScreenUpdating = False Set List = WsQ.Range("A2:A" & WsQ.Cells(WsQ.Rows.Count, 1).End(xlUp).Row) With WsZ Set Art = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row) For Each c In Art Set f = List.Find(c.Text, LookIn:=xlValues, lookat:=xlWhole) c.Offset(, 1).Value = f.Offset(, 1).Value c.Offset(, 2).Value = f.Offset(, 2).Value Next c End With End Sub

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 Art As Range, c As Range, List As Range, f As Range Application.ScreenUpdating = False Set List = WsQ.Range("A2:A" & WsQ.Cells(WsQ.Rows.Count, 1).End(xlUp).Row) With WsZ Set Art = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row) For Each c In Art Set f = List.Find(c.Text, LookIn:=xlValues, lookat:=xlWhole) If Not f Is Nothing Then c.Offset(, 1).Value = f.Offset(, 1).Value c.Offset(, 2).Value = f.Offset(, 2).Value End If Next c End With End Sub

Hallo Michael,
Ja sorry, das war mir leider vorher auch nicht bekannt :(
ich bin quasi drüber gestolpert. (schmeißt mit faulen Eiern nach mir, und gebt mir Tiernamen :-()
Und bitte entschuldige noch einmal, das hab ich wirklich vorher nicht bedacht.
Alsoo, ich weiss jetzt auch nicht recht wie man am einfachsten erschlagen könnte,
aber meine Idee bleibt danach bei einem 3. Tabellenblatt hängen, wo das Ergebnis reingeschrieben werden könnte. Achtung!! Die Staffellung könnte auch 4 oder 5-fach sein !!!
Folgende finale Erklärung zum Bild:
Im Bild sieht man links das Tabellenblatt mit allen Daten aus der Datenbank;
In der Mitte sind lediglich die Daten dargestellt, welche ich zum "Suchen" zur Verfügung habe.
Im rechten, das Tabellenblatt mit dem Wunschergebnis.
Userbild

Hallo!
ich bin quasi drüber gestolpert.
Alles schön und gut - aber warum stellst Du mir dann ein neues Bild ein, statt einer Bsp-Arbeitsmappe? Meinst Du es macht mir mehr Spaß, Dir eine zweite Lösung zu schreiben, wenn ich davor noch die Spiel-Daten manuell nachbauen darf? Denke bei zukünftigen Anfragen im Forum dran, dass es dem Antwortverhalten von Helferinnen zuträglich ist, wenn man deren Job angenehmer gestaltet...
Hier die neue Variante als Bsp-Datei: https://www.herber.de/bbs/user/113686.xlsm
...und hier als Code

Sub b()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQuell As Worksheet: Set WsQuell = Wb.Worksheets("Tabelle1")
Dim WsSuch As Worksheet: Set WsSuch = Wb.Worksheets("Tabelle2")
Dim WsZiel As Worksheet: Set WsZiel = Wb.Worksheets("Tabelle3")
Dim aDB, aNr, aCol, i&, j&, k&, l&, m&, n&
Application.ScreenUpdating = False
aDB = WsQuell.Range("A2:D" & _
WsQuell.Cells(WsQuell.Rows.Count, 1).End(xlUp).Row)
aNr = WsSuch.Range("A2:A" & WsSuch.Cells(WsSuch.Rows.Count, 1).End(xlUp).Row)
ReDim aCol(1 To UBound(aDB, 1), 1 To UBound(aDB, 2))
For i = LBound(aNr) To UBound(aNr)
For j = LBound(aDB) To UBound(aDB)
If aNr(i, 1) = aDB(j, 1) Then
l = l + 1
For k = 1 To UBound(aDB, 2)
aCol(l, k) = aDB(j, k)
Next k
End If
Next j
Next i
With WsZiel
For m = 1 To l
For n = 1 To UBound(aCol, 2)
.Cells(m, n) = aCol(m, n)
Next n
Next m
End With
Erase aDB: Erase aNr: Erase aCol
Set Wb = Nothing
Set WsQuell = Nothing
Set WsSuch = Nothing
Set WsZiel = Nothing
End Sub

Rückmeldung äußerst erwünscht!!!
LG
Michael

Beliebteste Forumthreads (12 Monate)

In Spalte suchen und dazugehörige Werte ausgeben

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

325 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

In Spalte suchen und dazugehörige Werte ausgeben

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

325 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread