Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1428to1432
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Loop Schleife mit MSG-Abfrage

Loop Schleife mit MSG-Abfrage
17.06.2015 14:22:53
Markus
Hallo Forum!!!
Nach langer, langer Zeit komme ich ohne euch nicht weiter und benoetige mal wieder eure Hilfe ... Das folgende Makro soll Eintraege suchen und bei Fund den entsprechenden Wert in ein anderes Arbeitsblatt uebertragen. Solange kein Treffer gefunden wird, wird die Tabelle weiterdurchsucht - das versuche ich mit einer Do...Loop Schleife, die ich aber leider nicht richtig hinbekomme... siehe folgenden Code.
Waere toll wenn mir jemand weiterhelfen koennte.
Vielen Dank vorab schonmal, viele Gruesse
Markus
Hier der Code:
Sub Suche()
Dim rng As Range
Dim sBegriff As String, sAddress, sCode As String
Dim Mldg
sBegriff = InputBox( _
prompt:="Bitte Suchbegriff eingeben:", _
Default:="Schaumermal")
If sBegriff = "" Then Exit Sub
Set rng = Cells.Find( _
what:=sBegriff, _
lookat:=xlPart, _
LookIn:=xlValues, _
MatchCase:=False, _
after:=ActiveCell)
If rng Is Nothing Then
Beep
MsgBox "Zeichenfolge leider nicht gefunden!", , _
Application.UserName
Exit Sub
End If
sAddress = rng.Address
rng.Select
MsgBox rng.Address(False, False)
Mldg = MsgBox("Ist dies der richtige Datensatz?", _
vbYesNo + vbQuestion, "Zeichenfolge gefunden")
If Mldg = vbYes Then
sCode = Range("B" & ActiveCell.Row).Value
Sheets("Tabelle1").Range("J4") = sCode
Exit Sub
Else
Do
Cells.FindNext(after:=ActiveCell).Activate
If ActiveCell.Address = sAddress Then Exit Sub
MsgBox ActiveCell.Address(False, False)
Mldg = MsgBox("Ist dies der richtige Datensatz?", _
vbYesNo + vbQuestion, "Zeichenfolge gefunden")
If Mldg = vbYes Then
sCodiceCliente = Range("B" & ActiveCell.Row).Value
Sheets("Tabelle1").Range("J4") = sCode
Loop
End If
End Sub

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Loop Schleife mit MSG-Abfrage
17.06.2015 14:51:40
Michael
Hi Markus,
die Schleife ist nicht das einzige Problem: schau die zwei Zeilen vor dem Loop an, da verwendest Du unterschiedliche Variablen, sCode usw.
Das läßt sich schon bei der Entwicklung durch option explicit und vernünftige Deklarationen (DIMs) vermeiden...
Abgesehen davon braucht es die Variable nicht, man kann die Zuweisung direkt in einer Zeile (bzw. einer Zuweisung) machen.
Hier der *minimal* veränderte Code:
Sub Suche()
Dim rng As Range
Dim sBegriff As String, sAddress, sCode As String
Dim Mldg
Dim weiter As Boolean
sBegriff = InputBox( _
prompt:="Bitte Suchbegriff eingeben:", _
Default:="Schaumermal")
If sBegriff = "" Then Exit Sub
Set rng = Cells.Find( _
what:=sBegriff, _
lookat:=xlPart, _
LookIn:=xlValues, _
MatchCase:=False, _
after:=ActiveCell)
If rng Is Nothing Then
Beep
MsgBox "Zeichenfolge leider nicht gefunden!", , _
Application.UserName
Exit Sub
End If
sAddress = rng.Address
rng.Select
MsgBox rng.Address(False, False)
Mldg = MsgBox("Ist dies der richtige Datensatz?", _
vbYesNo + vbQuestion, "Zeichenfolge gefunden")
If Mldg = vbYes Then
'        sCode = Range("B" & ActiveCell.Row).Value
'        Sheets("Tabelle1").Range("J4") = sCode
Sheets("Tabelle1").Range("J4").Value = _
Range("B" & ActiveCell.Row).Value
Exit Sub
Else
weiter = True
While weiter
Cells.FindNext(after:=ActiveCell).Activate
If ActiveCell.Address = sAddress Then Exit Sub
MsgBox ActiveCell.Address(False, False)
Mldg = MsgBox("Ist dies der richtige Datensatz?", _
vbYesNo + vbQuestion, "Zeichenfolge gefunden")
If Mldg = vbYes Then
'          sCode = Range("B" & ActiveCell.Row).Value
'          Sheets("Tabelle1").Range("J4") = sCode
Sheets("Tabelle1").Range("J4").Value = _
Range("B" & ActiveCell.Row).Value
weiter = False
End If
Wend
End If
End Sub
Schöne Grüße,
Michael

Anzeige
AW: Loop Schleife mit MSG-Abfrage
17.06.2015 17:31:34
Markus
Hallo,
vielen Dank vorab fuer die Unterstuetzung!
Michael, Deine while-wend-Loesung funzt hervorragend und loest mein Problem bis auf einen Anwendungsfall. Daher habe ich versucht in Deine while-schleife nach der letzten negativ beantworteten Pruefung folgende Meldung einzufuegen:
While weiter
Cells.FindNext(after:=ActiveCell).Activate
If ActiveCell.Address = sAddress Then
Beep
MsgBox "Kein weiterer Treffer vorhanden!", , _
Application.UserName
Exit Sub
Nun erhalte ich aber wieder die Fehlermeldung "wend ohne while"
Ich mache es mir hierbei wohl zu einfach ... ?
Kannst Du mir evtl. nochmal weiterhelfen?
Danke und Gruesse,
Markus

Anzeige
Erledigt: Loop Schleife mit MSG-Abfrage
18.06.2015 16:25:47
Markus
Hallo zusammen,
mittlerweile habe ich die Loesung gefunden, das Problem ist weniger "wend ohne while" als vielmehr ein fehlendes End If, der Rest bleibt so wie von Michael gepostet. So laeuft der code auch mit den weiteren Anweisungen nach dem Then:
While weiter
Cells.FindNext(after:=ActiveCell).Activate
If ActiveCell.Address = sAddress Then
Beep
MsgBox "Kein weiterer Treffer vorhanden!", , _
Application.UserName
Exit Sub
End If
Danke fuer die Hilfe und viele Gruesse,
Markus

AW: Erledigt: Loop Schleife mit MSG-Abfrage
18.06.2015 17:00:06
Michael
Hi Markus,
das Problem ist weniger "wend ohne while" als vielmehr ein fehlendes End If
Wohl gesprochen! Mit solchen "vielsagenden Meldungen" muß man sich halt herumschlagen.
Freu mich, wenn's tut.
Schöne Grüße,
Michael

Anzeige
AW: Loop Schleife mit MSG-Abfrage
17.06.2015 14:52:18
Hajo_Zi
vielleicht erfüllt der Code Deine Bedingungen?
Option Explicit
Public Sub Find_Methode()
Dim WkSh_1        As Worksheet
Dim WkSh_2        As Worksheet
Dim lZeile        As Long
Dim rZelle        As Range
Dim sFundst       As String
Dim sSuchbegriff  As String
sSuchbegriff = "j"
If sSuchbegriff  "" Then
Application.ScreenUpdating = False
Application.EnableEvents = False
'Set WkSh_1 = ThisWorkbook.Worksheets("Sicherung_Telefonliste")
Set WkSh_2 = ThisWorkbook.Worksheets("Telefonliste")
With WkSh_2.Columns(1)
'Set Rafound1 = Columns(1).Find("Erledigt", Range("A" & Rows.Count), xlFormulas, _
'                    xlWhole, , xlNext)
Set rZelle = .Find(sSuchbegriff, .Count, xlFormulas, xlWhole, xlValues)
If Not rZelle Is Nothing Then
sFundst = rZelle.Address
Do
' deine Aktionen mit rZelle.Offset(0,1)
'                    lZeile = WkSh_1.Cells(Rows.Count, 1).End(xlUp).Row + 1
'                    WkSh_2.Range("A" & rZelle.Row & ":H" & rZelle.Row).Copy
'                    WkSh_1.Range("A" & lZeile & ":H" & lZeile).PasteSpecial Paste:=xlValues
'                    WkSh_2.Range("A" & rZelle.Row & ":H" & rZelle.Row).Delete Shift:=xlUp
Set rZelle = .FindNext(rZelle)
Loop While Not rZelle Is Nothing And rZelle.Address  sFundst
End If
End With
Application.EnableEvents = True
Application.CutCopyMode = False         'Zwischenspeicher löschen
Application.ScreenUpdating = True
Set WkSh_1 = Nothing
'Set WkSh_2 = Nothing
Set rZelle = Nothing
End If
End Sub

Anzeige
Erledigt: Loop Schleife mit MSG-Abfrage
18.06.2015 16:30:46
Markus
Hallo Hajo,
Danke fuer die Hilfe! Ich gebe zu, dass ich aufgrund meiner bescheidenen VBA-Kenntnisse hier laenger gebraucht haette zu verstehen, was da abgeht ... Ich hab mir Deinen Code allerdings in meine Makrosammlung kopiert, wer weiss ob ich es doch noch einmal brauche ...
Danke und Gruesse
Markus

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige