Suche mit mehreren Kriterien

Guten Tag VBA-Forum_Mitglieder,
Ich habe dieses Forum entdeckt und viele hilfreiche Beiträge zu anderen Problemen, die ich habe, gefunden. Ich habe meine Frage bereits vor mehreren Tag in einem anderen Forum gestellt, aber leider konnte mir keiner weiterhelfen.
Ich konnte gerne nach einigen Antworten meinen bisherigen Code zeigen, aber erstmal möchte ich keine neuen Ideen und Meinungen leicht beeinflussen.
ich habe leider ein kleines Problem mit Excel VBA und komme nicht weiter. Könnte jemand mir bitte weiterhelfen, wenn es geht?
Mein Problem sieht folgendermaßen aus:
Ich habe zwei Worksheets, "Liste" und "Eingabe".
Ich will in "Eingabe" die Zellen L15, Q13 und Q15 ausfüllen. Danach soll mithilfe eines Makros in "Worksheets("liste") nach der Zeile mit diesen 3 Kriterien gesucht werden. Der entsprechende Wert von Worksheets("Eingabe").Range("L15") soll in Spalte("F:F"), der von Q13 in der Spalte ("I:I") und der von Q15 in der Spalte("J:J") in dem Worksheet("Liste") gesucht werden.
Wenn Diese Zeile gefunden wird, dann soll sich der Wert dieser Zeile in der Spalte( "L:L") um den vom Worksheets("Eingabe").Range("Q19") erhöht werden.
Wenn die Zeile mit den 3 Suchkriterien nicht gefunden wird, dann soll eine neue Zeile in Worksheets("Liste") mit diesen drei Werten erstellt werden. Aber eben so, dass Der Wert von L15 in die Spalte F, der von Q13 in der Spalte I, der von Q15 in der Spalte J und der von Q 19 in der Spalte L in der Liste stehen.
Vielleicht denke ich gerade zu kompliziert.
Ich freue mich über jede Antwort und Eure geschätzte Hilfe.
Grüße,
Moritz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Public Sub Suche_Finden_selecten2() Dim finden As Range Dim x As String Dim y As String Dim z As String Dim strFirstAddress As String Dim lngRow As Long Dim blnFound As Boolean With Worksheets("Eingabe") x = .Range("L15").Value y = .Range("Q13").Value z = .Range("Q15").Value End With With Worksheets("Werkzeugliste") Set finden = .Columns(6).Find(What:=x, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) If Not finden Is Nothing Then strFirstAddress = finden.Address Do lngRow = finden.Row If .Cells(lngRow, 9).Value = y And .Cells(lngRow, 10).Value = z Then blnFound = True Exit Do End If Set finden = .Columns(6).FindNext(After:=finden) Loop Until finden.Address = strFirstAddress Set finden = Nothing If blnFound Then .Cells(lngRow, 12).Value = Worksheets("Eingabe").Range("Q17").Value Else lngRow = .Cells(.Rows.Count, 6).End(xlUp).Offset(1, 0).Row .Cells(lngRow, 6).Value = x .Cells(lngRow, 9).Value = y .Cells(lngRow, 10).Value = z .Cells(lngRow, 12).Value = Worksheets("Eingabe").Range("Q17").Value End If Else lngRow = .Cells(.Rows.Count, 6).End(xlUp).Offset(1, 0).Row .Cells(lngRow, 6).Value = x .Cells(lngRow, 9).Value = y .Cells(lngRow, 10).Value = z .Cells(lngRow, 12).Value = Worksheets("Eingabe").Range("Q17").Value End If End With End Sub

Sub Suchen() Dim Zeile As Long, Z As Range Dim TB1 As Worksheet, TB2 As Worksheet Set TB1 = Sheets("Eingabe") Set TB2 = Sheets("Liste") Set Z = TB1.Range("ZZ1") 'Freie temporäre Zelle Z.Formula2R1C1 = "=MATCH(R15C12&R13C17&R15C17," & TB2.Name & "!C6&" & TB2.Name & "!C9&" & TB2.Name & "!C10,0)" ' benutze Formel =VERGLEICH($L$15&$Q$13&$Q$15;Liste!$F:$F&Liste!$I:$I&Liste!$J:$J;0) If IsNumeric(Z.Value) Then Zeile = Z.Value Z.ClearContents With TB2.Range("L" & Zeile) .Value = .Value + TB1.Range("Q19") End With Else Zeile = TB2.Cells(TB2.Rows.Count, "F").End(xlUp).Row + 1 'erste freie Zeile der Spalte TB2.Range("F" & Zeile) = TB1.Range("L15") TB2.Range("I" & Zeile) = TB1.Range("Q13") TB2.Range("J" & Zeile) = TB1.Range("Q15") TB2.Range("L" & Zeile) = TB1.Range("Q19") End If End Sub

Sub Suchen() Dim Zeile As Variant Dim TB1 As Worksheet, TB2 As Worksheet Dim Z1 As Range, Z2 As Range, Z3 As Range, Z4 As Range Set TB1 = Sheets("Eingabe") Set TB2 = Sheets("Liste") Set Z1 = TB1.Range("L15") Set Z2 = TB1.Range("Q13") Set Z3 = TB1.Range("Q15") Set Z4 = TB1.Range("Q19") With TB2 Zeile = Evaluate("MATCH(""" & Z1 & """&""" & Z2 & """&""" & Z3 & """," & _ .Name & "!$F:$F&" & .Name & "!$I:$I&" & .Name & "!$J:$J,0)") If IsNumeric(Zeile) Then 'bereits vorhanden With .Range("L" & Zeile) .Value = .Value + Z4 End With Else 'neu anlegen Zeile = .Cells(.Rows.Count, "F").End(xlUp).Row + 1 'erste freie Zeile der Spalte .Range("F" & Zeile) = Z1 .Range("I" & Zeile) = Z2 .Range("J" & Zeile) = Z3 .Range("L" & Zeile) = Z4 End If End With End Sub

Sub Suchen3() Dim Zeile As Variant Dim TB1 As Worksheet, TB2 As Worksheet Dim Z1 As Range, Z2 As Range, Z3 As Range, Z4 As Range Set TB1 = Sheets("Eingabe") Set TB2 = Sheets("Liste") Set Z1 = TB1.Range("L15") Set Z2 = TB1.Range("Q13") Set Z3 = TB1.Range("Q15") Set Z4 = TB1.Range("Q19") With TB2 Zeile = Evaluate("MATCH(""" & Z1 & """&""" & Z2 & """&""" & Z3 & """," & _ .Name & "!$F:$F&" & .Name & "!$I:$I&" & .Name & "!$J:$J,0)") If IsNumeric(Zeile) Then 'bereits vorhanden With .Range("L" & Zeile) If .Value = 0 Then .EntireRow.Delete xlUp Else .Value = .Value + Z4 End If End With Else 'neu anlegen Zeile = .Cells(.Rows.Count, "F").End(xlUp).Row + 1 'erste freie Zeile der Spalte .Range("F" & Zeile) = Z1 .Range("I" & Zeile) = Z2 .Range("J" & Zeile) = Z3 .Range("L" & Zeile) = Z4 End If End With End Sub

Beliebteste Forumthreads (12 Monate)

21
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

310 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Suche mit mehreren Kriterien

21 Beiträge zum Forumthread Beiträge zu diesem Forumthread

310 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

21
Beiträge zum Forumthread

Beiträge zu diesem Forumthread