Hi, ich habe mal eine Frage. Und zwar habe ich folgendes Makro und ich bekomme es nicht hin, "Suchwert" und "Suchwert1" so zu verknüpfen, dass er mir nur dann die Werte herauskopiert, wenn beide Suchwerte in der Zeile erfüllt sind. Dabei ist zu sagen, dass "Suchwert" über eine Inbox abgefragt wird und "Suchwert1" immer ein konstanter Wert ist, der berücksichtigt werden sollte. Wenn ich das folgende Makro benutze, spuckt er mir auch andere Maschinenbezeichnungen aus aus in dennen "SuchWert1" vorhanden ist
Danke schon mal für eure Tipps
Sub Maschine ()
Dim SuchErgebnis As Range
Dim lngZielZeile As Long
Dim SuchWert As String
Dim SuchWert1 As String
Dim lngZaehler As Long
Dim firstAddress
Dim intSpalte As Integer
lngZielZeile = 3
SuchWert = InputBox("Bitte die Maschinennummer eingeben z.b FI \ 6") 'Suchwert eingeben (Welche Maschine zb.)
SuchWert1 = "In Produktion"
If StrPtr(SuchWert) = 0 Then Exit Sub 'Abbruchbefehl wenn nix eingeben wird
lngZaehler = 0
With Sheets("Produktionsplanung") ' Tabelle in welcher der Wert gesucht wird bitte den richtigen Tabellenamen angeben der auch unten im Reiter steht
Set SuchErgebnis = .Range("A5:AY30").Find(SuchWert, LookIn:=xlValues, LookAt:=xlWhole) 'hier wird der Suchbereich angegeben in welchem der passenden Werte gesucht wird
Set SuchErgebnis = .Range("A5:AY30").Find(SuchWert1, LookIn:=xlValues, LookAt:=xlWhole)
If Not SuchErgebnis Is Nothing Then
firstAddress = SuchErgebnis.Address
Do
For intSpalte = 1 To 1 'welche Spalten sollen Kopiert werden? die Spaltennummern können durch die Zahlen geändert werden
Sheets("MaschineNr1").Cells(lngZielZeile, 2) = .Cells(SuchErgebnis.Row, _
intSpalte) 'das Tabellenblatt was hier in Klammern steht muss angepasst werden wenn in ein anderes Blatt kopiert werden soll
Next
For intSpalte = 2 To 2
Sheets("MaschineNr1").Cells(lngZielZeile, 3) = .Cells(SuchErgebnis.Row, _
intSpalte)
Next
For intSpalte = 6 To 6
Sheets("MaschineNr1").Cells(lngZielZeile, 4) = .Cells(SuchErgebnis.Row, _
intSpalte)
Next
For intSpalte = 10 To 10
Sheets("MaschineNr1").Cells(lngZielZeile, 5) = .Cells(SuchErgebnis.Row, _
intSpalte)
Next
For intSpalte = 11 To 11
Sheets("MaschineNr1").Cells(lngZielZeile, 6) = .Cells(SuchErgebnis.Row, _
intSpalte)
Next
For intSpalte = 7 To 7
Sheets("MaschineNr1").Cells(lngZielZeile, 7) = .Cells(SuchErgebnis.Row, _
intSpalte)
Next
For intSpalte = 8 To 8
Sheets("MaschineNr1").Cells(lngZielZeile, 8) = .Cells(SuchErgebnis.Row, _
intSpalte)
Next
For intSpalte = 9 To 9
Sheets("MaschineNr1").Cells(lngZielZeile, 9) = .Cells(SuchErgebnis.Row, _
intSpalte)
Next
For intSpalte = 43 To 43
Sheets("MaschineNr1").Cells(lngZielZeile, 10) = .Cells(SuchErgebnis.Row, _
intSpalte)
Next
For intSpalte = 44 To 44
Sheets("MaschineNr1").Cells(lngZielZeile, 11) = .Cells(SuchErgebnis.Row, _
intSpalte)
Next
lngZielZeile = lngZielZeile + 1
lngZaehler = lngZaehler + 1
Set SuchErgebnis = .Range("A5:AY30").FindNext(SuchErgebnis) ' Suchbereich in der Tabelle1(Produktionsplanung)
Loop While Not SuchErgebnis Is Nothing And SuchErgebnis.Address <> firstAddress
MsgBox "Es wurden zum Suchwert " & SuchWert _
& vbCrLf & lngZaehler & " Datensätze kopiert" 'Textbox für die Ausgabe was gefunden wurde der Text kann variabel angepasst werden oder gelöscht werden
Else
MsgBox "Kein Eintrag" 'Textbox wenn nix Gefunden wurde der Text kann variabel angepasst werden
End If
End With
With Sheets("MaschineNr1") ' Abschnitt in dem die Menge der 20 Litergebinde überprüft wird und und rausgelöscht wird
For lngZielZeile = .Cells(.Rows.Count, 7).End(xlUp).Row To 3 Step -1
If .Cells(lngZielZeile, 7).Value = 20 Then
If .Cells(lngZielZeile, 8).Value >= 20 Then
.Rows(lngZielZeile).EntireRow.Delete
End If
End If
Next lngZielZeile
End With
End Sub
|