Thema Datum  Von Nutzer Rating
Antwort
Rot Suchwerte verknüpfen
16.02.2023 17:16:39 Nils
NotSolved
16.02.2023 19:01:50 Gast01287
NotSolved
16.02.2023 19:04:00 Gast01287
NotSolved
16.02.2023 19:17:31 Nils
NotSolved
16.02.2023 19:53:44 Gast1204
NotSolved
16.02.2023 20:10:02 Nils
NotSolved
16.02.2023 20:29:11 Gast01233
NotSolved
16.02.2023 21:15:42 Gast88494
NotSolved
16.02.2023 21:18:43 Gast01233
NotSolved
16.02.2023 21:34:35 Gast85642
NotSolved
16.02.2023 21:53:39 Gast01233
NotSolved
16.02.2023 22:02:32 Gast96547
NotSolved
16.02.2023 22:20:51 Gast01233
Solved

Ansicht des Beitrags:
Von:
Nils
Datum:
16.02.2023 17:16:39
Views:
1357
Rating: Antwort:
  Ja
Thema:
Suchwerte verknüpfen

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

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Suchwerte verknüpfen
16.02.2023 17:16:39 Nils
NotSolved
16.02.2023 19:01:50 Gast01287
NotSolved
16.02.2023 19:04:00 Gast01287
NotSolved
16.02.2023 19:17:31 Nils
NotSolved
16.02.2023 19:53:44 Gast1204
NotSolved
16.02.2023 20:10:02 Nils
NotSolved
16.02.2023 20:29:11 Gast01233
NotSolved
16.02.2023 21:15:42 Gast88494
NotSolved
16.02.2023 21:18:43 Gast01233
NotSolved
16.02.2023 21:34:35 Gast85642
NotSolved
16.02.2023 21:53:39 Gast01233
NotSolved
16.02.2023 22:02:32 Gast96547
NotSolved
16.02.2023 22:20:51 Gast01233
Solved