Tabelle durchsuchen
27.08.2018 13:46:18
Micha
anbei eine kleine Exceldatei, wo ich nicht weiterkomme.
https://www.herber.de/bbs/user/123589.xlsm
Beschreibung:
Tabellenblatt 2; Spalte A2:A100 enthalten Namen, Spalte B2:B100 Nummern. Dabei gehört die Zelle in Spalte A immer zu der Zelle in Spalte B. Bspw. Max Mustermann und 5678.
Tabellenblatt 1; Spalte D4:D100 enthalten die gleichen Nummern wie in Tab2 aber in anderer Reihenfolge, Zeile F6:F100 die gleichen Namen aber in anderer Reihenfolge.
Ziel:
Zuerst soll der Namen von Tabelle2 in Tabelle 1 gesucht werden, danach das gleiche mit der Nummer. Ist die Zeile und Spalte auf Tabelle1 bekannt, soll von Tabelle 2 die Zahl aus Spalte C in die entsprechende Zelle geschrieben werden.
Hier das Makro:
Sub Sortierung2()
Dim Teilname As String
Dim Suche As Long
Dim Nummer As Long
Dim Namen As String
Dim Text As String
Dim Auftrag As String
Dim Nummer1 As String
Dim Nummer11 As String
Dim i As Long
Dim j As Long
Dim a As Long
Dim b As Long
Application.ScreenUpdating = False
'Variable festlegen
Namen = Worksheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row
Nummer1 = Worksheets("Tabelle2").Cells(Rows.Count, 2).End(xlUp).Row
Suche = Worksheets("Tabelle1").Cells(Columns.Count, 6).End(xlToRight).Columns
Nummer = Worksheets("Tabelle1").Cells(Rows.Count, 4).End(xlUp).Rows
For a = 2 To Namen
Text = Worksheets("Tabelle2").Cells(a, 1).Value
For b = 2 To Nummer
Auftrag = Worksheets("Tabelle2").Cells(b, 2).Value
For j = 6 To Suche
Teilname = Worksheets("Tabelle1").Cells(2, j).Value
For i = 4 To Nummer1
Nummer11 = Worksheets("Tabelle1").Cells(i, 4).Value
If Text Like "*" & Teilname & "*" & Auftrag Like "*" & Nummer11 & "*" Then
Sheets("Tabelle2").Range("i,3").Value = Worksheets("Tabelle1").Cells(i, j). _
Value
Exit For
Next a
Next b
Next j
Next i
End If
Exit For
Application.ScreenUpdating = True
End Sub
Irgendwo habe ich einen Wurm drin.
Kann mir da jemand helfen?
Danke vielmals.
Grüße
Micha