Supportnet / Forum / Tabellenkalkulation
Makro Suchfunktion mit Abbruchbedingung
Frage
Hallo zusammen
Erstmal zu erklärung des unteren Codes " Es öffnet sich eine Fenster in die AuftragsNR. geucht werden kann. In Spalte E wird dann nache der NR gesucht. Wenn die NR gefunden wird dann wieder die NR in Spalte L kopiert und die ganze Zeile wo die NR drinne steht und wird in eine neues Tabellenblat Namens "Auftrag_gef" kopiert. Wenn die AufragsNR nicht gefunden wird bricht die Makro ab."
Jetzt zu meinem Problem: Wenn eine Nr. doppelt gesucht wird, wird sie gefunden und im Auftag_gef Tabellenblatt abegespeichet (also habe ich doppelte einträge in der Tabelle wenn man eine Nr. zweimal sucht.
Meine Frage: Wer ist in der lage meine Makro (Code) so um zu schreiben das die Suchfunktion eine MsgBox öffent und sagt "AuftragsNr. wurde schon gesucht und gefunden" Wenn in der dazu gefunden Zeile schan in Spalte L ein Wert eingetragen worden ist ( Wenn in in gefunden Zeile Spalte L <> Leer [b] WAHR[/b] dann suche weiter führen.
wenn in gefundener Zeile Spalte L <> Leer [b] FALSCH[/b] dann MsgBox öffnen und sagen "AuftragsNr. wurde schon gefunden und gesucht )
CODE
[b] Sub AuftragsNRSuche ()
´Auftragsnummer erfassen und suchen
Auftragsnummer = InputBox("Die Auftragsnummer eingeben." & _
"Es wird die Auftragsnummer gesucht.")
On Error Resume Next
Columns("E:E").Select
Selection.Find(what:=Auftragsnummer, after:=ActiveCell, LookIn:=xlValues, lookat _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
´Fehlerausgang, falsche Auftragsnummer oder keine
If Err <> 0 Then
MsgBox "Kann die Auftragsnummer nicht finden " & Auftragsnummer
End
End If
If Auftragsnummer = False Then
Range("A1").Select
End
End If
´Zeile der AuftragsNR wir in nächste freue Zeile von Auftrag_gef kopiert
loletzte = IIf(IsEmpty(Worksheets("Auftrag_gef").Range("B65536")), Worksheets("Auftrag_gef").Range("B65536").End(xlUp).Row, 65536) + 1
Set c = Columns(5).Find(Auftragsnummer, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
´kopieren der Auftragsnummer
Cells(c.Row, 12) = c.Value
Rows(c.Row).Copy Destination:=Worksheets("Auftrag_gef").Rows(loletzte)
loletzte = loletzte + 1
Set c = Columns(5).FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
Next Schleife
End Sub[/b]
Antwort 1 von coros
Hi ,
nachfolgend der geänderte Code mit der MsgBox. Ich hoffe, ich habe es richtig verstanden, was Du wolltest. Wenn nicht, dann melde Dich. Übrigens, wozu steht denn der Aufruf "Next Schleife" am Ende des Codes, wenn in dem gesamten Makro keine Schleife vorhanden ist?
MfG,
coros
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
nachfolgend der geänderte Code mit der MsgBox. Ich hoffe, ich habe es richtig verstanden, was Du wolltest. Wenn nicht, dann melde Dich. Übrigens, wozu steht denn der Aufruf "Next Schleife" am Ende des Codes, wenn in dem gesamten Makro keine Schleife vorhanden ist?
Sub AuftragsNRSuche()
´Auftragsnummer erfassen und suchen
Auftragsnummer = InputBox("Die Auftragsnummer eingeben." & _
"Es wird die Auftragsnummer gesucht.")
On Error Resume Next
Columns("E:E").Select
Selection.Find(what:=Auftragsnummer, after:=ActiveCell, LookIn:=xlValues, lookat _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
´Fehlerausgang, falsche Auftragsnummer oder keine
If Err <> 0 Then
MsgBox "Kann die Auftragsnummer nicht finden " & Auftragsnummer
End
End If
If Auftragsnummer = False Then
Range("A1").Select
End
End If
Frage = 0
´Zeile der AuftragsNR wir in nächste freue Zeile von Auftrag_gef kopiert
loletzte = IIf(IsEmpty(Worksheets("Auftrag_gef").Range("B65536")), Worksheets("Auftrag_gef").Range("B65536").End(xlUp).Row, 65536) + 1
Set c = Columns(5).Find(Auftragsnummer, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If Frage = 1 And Cells(c.Row, 12) = Empty Then
MsgBox "AuftragsNr. wurde schon gefunden und gesucht"
Exit Sub
Else
´kopieren der Auftragsnummer
Cells(c.Row, 12) = c.Value
Rows(c.Row).Copy Destination:=Worksheets("Auftrag_gef").Rows(loletzte)
loletzte = loletzte + 1
Frage = 1
End If
Set c = Columns(5).FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
´Next Schleife
End Sub
MfG,
coros
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 2 von Hellchampion
Warum Next Schleife das sehte weil die Frage mit der MsgBox 100 aufgerufen wird (Schleife)
Leider hat es nicht funktioniert da jetzt immer gleich die meldung AuftragsNr. gefunden auftaucht und es wird auch immer noch auf das zweite Tabellenblatt "Auftrag_gef" die gefundene Zeile Kopiert (doppelt opiert), aber dieses soll nicht geschehen wenn die AuftragsNr. schon einmal gesucht worden ist.
Leider hat es nicht funktioniert da jetzt immer gleich die meldung AuftragsNr. gefunden auftaucht und es wird auch immer noch auf das zweite Tabellenblatt "Auftrag_gef" die gefundene Zeile Kopiert (doppelt opiert), aber dieses soll nicht geschehen wenn die AuftragsNr. schon einmal gesucht worden ist.
Antwort 3 von coros
Hallo Hellchampion,,
ich glaube ich habe das vorher nicht richtig gelesen. Also Du möchtest, dass die Zeilen, die die Suchnummer haben und in denen in Spalte Lnichts steht, in das andere Tabellenblatt kopiert werden. Wenn die erste gefundene Nummer in der gleichen Zeile in Spalte L etwas steht, soll die Meldung erscheinen. Ist das richtig oder verstehe ich da etwas völlig falsch.
Nachfolgendes Makro sollte das so machen, wie ich oben gefragt habe.
Im Übrigen weiß ich immer noch nicht, warum dort ein Schleifenaufruf steht, denn ich kann mit der Antwort von Dir nichts anfangen, da ich keine MsgBox 100 sehen kann. Aber kann mir ja auch egal sein.
MfG,
coros
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
ich glaube ich habe das vorher nicht richtig gelesen. Also Du möchtest, dass die Zeilen, die die Suchnummer haben und in denen in Spalte Lnichts steht, in das andere Tabellenblatt kopiert werden. Wenn die erste gefundene Nummer in der gleichen Zeile in Spalte L etwas steht, soll die Meldung erscheinen. Ist das richtig oder verstehe ich da etwas völlig falsch.
Nachfolgendes Makro sollte das so machen, wie ich oben gefragt habe.
Sub AuftragsNRSuche()
´Auftragsnummer erfassen und suchen
Auftragsnummer = InputBox("Die Auftragsnummer eingeben." & _
"Es wird die Auftragsnummer gesucht.")
On Error Resume Next
Columns("E:E").Select
Selection.Find(what:=Auftragsnummer, after:=ActiveCell, LookIn:=xlValues, lookat _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
´Fehlerausgang, falsche Auftragsnummer oder keine
If Err <> 0 Then
MsgBox "Kann die Auftragsnummer nicht finden " & Auftragsnummer
End
End If
If Auftragsnummer = False Then
Range("A1").Select
End
End If
Frage = 0
´Zeile der AuftragsNR wir in nächste freue Zeile von Auftrag_gef kopiert
loletzte = IIf(IsEmpty(Worksheets("Auftrag_gef").Range("B65536")), Worksheets("Auftrag_gef").Range("B65536").End(xlUp).Row, 65536) + 1
Set c = Columns(5).Find(Auftragsnummer, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If Frage = 1 And Cells(c.Row, 12) = NoEmpty Then
MsgBox "AuftragsNr. wurde schon gefunden und gesucht"
Exit Sub
Else
´kopieren der Auftragsnummer
Cells(c.Row, 12) = c.Value
Rows(c.Row).Copy Destination:=Worksheets("Auftrag_gef").Rows(loletzte)
loletzte = loletzte + 1
Frage = 1
End If
Set c = Columns(5).FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
´Next Schleife
End Sub
Im Übrigen weiß ich immer noch nicht, warum dort ein Schleifenaufruf steht, denn ich kann mit der Antwort von Dir nichts anfangen, da ich keine MsgBox 100 sehen kann. Aber kann mir ja auch egal sein.
MfG,
coros
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 4 von Hellchampion
Leider macht es das immer noch nicht so wie ich es mir gedacht habe.
Ich starte die Suchfunktion die sucht dann in Spalte E nach der AUftragsNr -> wenn diese gefunden worden ist dann schreibt er in die selbe Zeile wie die gefundene AuftragsNr. die Nr noch mal in Spalte L hin und dazu kommt noch dann wird die ganze Zeile kopiert in das Neue Tabellenblatt "Auftrags_gef"
Problem jetzt: wenn ich zeimal nach der selben Nr. suche dann wird die Nr. gefunden und die ganze Zeile wider ins Tabellenblat "Auftrag_gef" kopiert (doppelte einträge) Ich will aber keine doppelten einträge im Tabellenblat "Auftrag_gef" haben.
Also soll bevor er mir die gefunden Zeile in Tabellenblatt "Auftrag_gef" kopiert forher überprüftwerden ob die AuftragsNr. schon einmal gesucht (in Tabellenblatt "Auftrag_gef" kopiert wurden ist) oder ob eine Eintrag (AuftragsNr. in Spalte L auf Tabellenblatt "Zusammenfassung" in der zu Kopierenden Zeile eingetragen worden ist)
und das mit der Schleife hier der CODE zur erklärung:
For Schleife = 1 To 100
´Auftragsnummer erfassen und suchen
Auftragsnummer = InputBox("Die Auftragsnummer eingeben." & _
"Es wird die Auftragsnummer gesucht.")
On Error Resume Next
Columns("E:E").Select
Selection.Find(what:=Auftragsnummer, after:=ActiveCell, LookIn:=xlValues, lookat _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
´Fehlerausgang, falsche Auftragsnummer oder keine
If Err <> 0 Then
MsgBox "Kann die Auftragsnummer nicht finden " & Auftragsnummer
End
End If
If Auftragsnummer = False Then
Range("A1").Select
End
End If
Frage = 0
´Zeile der AuftragsNR wir in nächste freue Zeile von Auftrag_gef kopiert
loletzte = IIf(IsEmpty(Worksheets("Auftrag_gef").Range("B65536")), Worksheets("Auftrag_gef").Range("B65536").End(xlUp).Row, 65536) + 1
Set c = Columns(5).Find(Auftragsnummer, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If Frage = 1 And Cells(c.Row, 12) = NoEmpty Then
MsgBox "AuftragsNr. wurde schon gefunden und gesucht"
Exit Sub
Else
´kopieren der Auftragsnummer
Cells(c.Row, 12) = c.Value
Rows(c.Row).Copy Destination:=Worksheets("Auftrag_gef").Rows(loletzte)
loletzte = loletzte + 1
Frage = 1
End If
Set c = Columns(5).FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
Next Schleife
Ich starte die Suchfunktion die sucht dann in Spalte E nach der AUftragsNr -> wenn diese gefunden worden ist dann schreibt er in die selbe Zeile wie die gefundene AuftragsNr. die Nr noch mal in Spalte L hin und dazu kommt noch dann wird die ganze Zeile kopiert in das Neue Tabellenblatt "Auftrags_gef"
Problem jetzt: wenn ich zeimal nach der selben Nr. suche dann wird die Nr. gefunden und die ganze Zeile wider ins Tabellenblat "Auftrag_gef" kopiert (doppelte einträge) Ich will aber keine doppelten einträge im Tabellenblat "Auftrag_gef" haben.
Also soll bevor er mir die gefunden Zeile in Tabellenblatt "Auftrag_gef" kopiert forher überprüftwerden ob die AuftragsNr. schon einmal gesucht (in Tabellenblatt "Auftrag_gef" kopiert wurden ist) oder ob eine Eintrag (AuftragsNr. in Spalte L auf Tabellenblatt "Zusammenfassung" in der zu Kopierenden Zeile eingetragen worden ist)
und das mit der Schleife hier der CODE zur erklärung:
For Schleife = 1 To 100
´Auftragsnummer erfassen und suchen
Auftragsnummer = InputBox("Die Auftragsnummer eingeben." & _
"Es wird die Auftragsnummer gesucht.")
On Error Resume Next
Columns("E:E").Select
Selection.Find(what:=Auftragsnummer, after:=ActiveCell, LookIn:=xlValues, lookat _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
´Fehlerausgang, falsche Auftragsnummer oder keine
If Err <> 0 Then
MsgBox "Kann die Auftragsnummer nicht finden " & Auftragsnummer
End
End If
If Auftragsnummer = False Then
Range("A1").Select
End
End If
Frage = 0
´Zeile der AuftragsNR wir in nächste freue Zeile von Auftrag_gef kopiert
loletzte = IIf(IsEmpty(Worksheets("Auftrag_gef").Range("B65536")), Worksheets("Auftrag_gef").Range("B65536").End(xlUp).Row, 65536) + 1
Set c = Columns(5).Find(Auftragsnummer, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If Frage = 1 And Cells(c.Row, 12) = NoEmpty Then
MsgBox "AuftragsNr. wurde schon gefunden und gesucht"
Exit Sub
Else
´kopieren der Auftragsnummer
Cells(c.Row, 12) = c.Value
Rows(c.Row).Copy Destination:=Worksheets("Auftrag_gef").Rows(loletzte)
loletzte = loletzte + 1
Frage = 1
End If
Set c = Columns(5).FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
Next Schleife
Antwort 5 von coros
Nabend,
sorry, aber irgendwie bin ich heute scheinbar nicht ganz auf der Höhe. Ich verstehe es immer noch nicht so richtiig. Aber ich geben mir Mühe es zu verstehen. Nachfolgend mal ein neuer Versuch. In diesem Lösungsversuch wird in dem Blatt, in das die Daten kopiert werden geprüft, ob es in Spalte E schon einen Eintrag mit der gleichen Nummer gibt. Wenn ja, dann erscheint die Meldung, wenn nein, wird kopiert. Was ich jetzt nicht verstanden habe (ich hoffe mal ich habe überhaupt was verstanden ;-)) ob das Prüfen in dem Blatt "Auftrag_gef" reicht oder ob auch noch die Spalte L mit geprüft werden soll.
Probiers mal aus. Aber ich vermute mal, ich liege wieder voll daneben oder etwa doch nicht?
MfG,
coros
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
sorry, aber irgendwie bin ich heute scheinbar nicht ganz auf der Höhe. Ich verstehe es immer noch nicht so richtiig. Aber ich geben mir Mühe es zu verstehen. Nachfolgend mal ein neuer Versuch. In diesem Lösungsversuch wird in dem Blatt, in das die Daten kopiert werden geprüft, ob es in Spalte E schon einen Eintrag mit der gleichen Nummer gibt. Wenn ja, dann erscheint die Meldung, wenn nein, wird kopiert. Was ich jetzt nicht verstanden habe (ich hoffe mal ich habe überhaupt was verstanden ;-)) ob das Prüfen in dem Blatt "Auftrag_gef" reicht oder ob auch noch die Spalte L mit geprüft werden soll.
For Schleife = 1 To 100
´Auftragsnummer erfassen und suchen
Auftragsnummer = InputBox("Die Auftragsnummer eingeben." & _
"Es wird die Auftragsnummer gesucht.")
If Auftragsnummer = "" Then Exit Sub
With Sheets("Auftrag_gef").Range("E1:E65536")
Set Gefunden = .Find(What:=Auftragsnummer, LookIn:=xlValues)
If Not Gefunden Is Nothing Then
Addresse = Gefunden.Address
MsgBox "AuftragsNr. wurde schon gefunden und gesucht"
GoTo Ende
Do
Set Gefunden = .FindNext(Gefunden)
Loop While Not Gefunden Is Nothing And Gefunden.Address <> Addresse
End If
End With
On Error Resume Next
Columns("E:E").Select
Selection.Find(What:=Auftragsnummer, after:=ActiveCell, LookIn:=xlValues, lookat _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
´Fehlerausgang, falsche Auftragsnummer oder keine
If Err <> 0 Then
MsgBox "Kann die Auftragsnummer nicht finden " & Auftragsnummer
End
End If
If Auftragsnummer = False Then
Range("A1").Select
End
End If
´Zeile der AuftragsNR wir in nächste freue Zeile von Auftrag_gef kopiert
loletzte = IIf(IsEmpty(Worksheets("Auftrag_gef").Range("B65536")), Worksheets("Auftrag_gef").Range("B65536").End(xlUp).Row, 65536) + 1
Set c = Columns(5).Find(Auftragsnummer, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
´kopieren der Auftragsnummer
Cells(c.Row, 12) = c.Value
Rows(c.Row).Copy Destination:=Worksheets("Auftrag_gef").Rows(loletzte)
loletzte = loletzte + 1
Set c = Columns(5).FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
Ende:
Next Schleife
Probiers mal aus. Aber ich vermute mal, ich liege wieder voll daneben oder etwa doch nicht?
MfG,
coros
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 6 von Hellchampion
Ja ganau das habe ich gebraucht, danke
Es hat jetzt 1A funktioniert
Das Prüfen in Auftrag_gef reit volkommen aus. Ist sagar besser als wenn ich im alten Tabellenblatt die überprüfung abläuft.
Siehst du hast es doch verstanden was ich wollte :-)
Ich war schon drauf und drann die ganzen Makros umzuschreiben so das die Zeilen erst am ende Kopiert werden wenn alles durchsucht wordne ist so entgehe ich dann auch den doppelten einträgen.
Noch mals Herzlichen Danke !!!!
Gruß Hell
Es hat jetzt 1A funktioniert
Das Prüfen in Auftrag_gef reit volkommen aus. Ist sagar besser als wenn ich im alten Tabellenblatt die überprüfung abläuft.
Siehst du hast es doch verstanden was ich wollte :-)
Ich war schon drauf und drann die ganzen Makros umzuschreiben so das die Zeilen erst am ende Kopiert werden wenn alles durchsucht wordne ist so entgehe ich dann auch den doppelten einträgen.
Noch mals Herzlichen Danke !!!!
Gruß Hell