Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
928to932
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
928to932
928to932
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Inputbox abbrechen Fehler !!!

Inputbox abbrechen Fehler !!!
30.11.2007 12:52:00
broker
hallo experten
ich habe im Forum einen vba code gefunden der super funkioniert ich habe ihn an meine bedürfnisse angepasst. es funktioniert alles prima bis auf die inputbox die ewig weiterläuft.
das ziel diese codes ist das suchen in der userform listbox1 und das gefundene in die tabelle suchwerte zu kopieren und dann die tabelle markieren und fertig machen zum kopieren.
wenn ich in der inputbox auf abbrechen klicke dann läüft der code endlos weiter und es passiert nix .wo ist der fehler .
bitte um hilfe.

Sub MultiSelect()
On Error Resume Next
If Err.Number  0 Then
MsgBox "Kein Eintrag vorhanden!", vbCritical, "Schreiben Sie was rein"
End If
Dim wks As Worksheet
Dim rngFind As Range, rngRows As Range
Dim lngRow As Long
Dim strFind As String, strSearch As String
'TEBELLE VOR DEM EINFÜGEN LEEREN
Application.ScreenUpdating = False
Sheets("Suchwerte").Select
Columns("A:F").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Sheets("Vergleich").Select
'suchbeginn
strSearch = InputBox("Suchbegriff:", , "Turk")
Set rngFind = Cells.Find(strSearch)
If rngRows Is Nothing Then
Set rngRows = rngFind
End If
If Not rngFind Is Nothing Then       'H I E R V ER R M U T E I C H D E N F EH L ER
strFind = rngFind.Address
Do
Set rngRows = Application.Union(rngRows, rngFind.EntireRow)
Set rngFind = Cells.FindNext(After:=rngFind)
If rngFind.Address = strFind Then Exit Do
Loop
End If
rngRows.Select
Selection.Copy
Cells(1, 1).Select
'TEST BEGINN
'EINFÜGEN
Sheets("Suchwerte").Select
Range("A1").Select
ActiveSheet.Paste
'spaltenberite einstellen
Columns("A:F").Select
Columns("A:F").EntireColumn.AutoFit
Range("B1").Select
'Sheets.Add
'ActiveSheet.Name = "Suchwerte" & Sheets.Count
'ActiveSheet.Paste
Cells(1, 1).Select
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
Range("B1:D75").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub


4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Inputbox abbrechen Fehler !!!
30.11.2007 13:19:00
Ramses
Hallo
Der Fehler ist schon weiter oben
strSearch = InputBox("Suchbegriff:", , "Turk")
If StrPtr(strSearch) 0 Then Exit sub
Gruss Rainer

AW: Inputbox abbrechen Fehler !!!
30.11.2007 13:36:00
broker
vielen dank für die schnelle antwort
ich habe jetzt genau das eingefügt was du geschrieben hast unter
strSearch = InputBox("Suchbegriff:", , "Turk")
If StrPtr(strSearch) 0 Then Exit sub
genau das gleich promlem wie vorher
hast vieleich noch etwas für mich wäre dir sehr dankbar
gruss
broker

Noch offen...
30.11.2007 13:50:15
Ramses
Hallo
"...wenn ich in der inputbox auf abbrechen klicke dann läüft der code endlos weiter..."
Sorry, aber meine Antwort löst exact dein problem, nämlich wenn in der Inputbox auf abbrechen geklickt wurde.
Dein Problem
If Not rngFind Is Nothing Then 'H I E R V ER R M U T E I C H D E N F EH L ER
strFind = rngFind.Address
Do
mag schon korrekt beschrieben sein, aber das mit der Inputbox ist dann nicht der Fehler.
Ich kann das nicht beurteilen was du erreichen willst, aber die StringSuche nach der Zelladresse !! wird wohl immer auf einen Fehler laufen.
Aus deinem Code werde ich nicht schlau was du hier erreichen willst, daher die Frage noch auf offen.
gruss Rainer

Anzeige
AW: Noch offen...
30.11.2007 14:06:00
broker
danke das du dich so bemühst
ich habe es jetzt noch mal getestet es geht aber es dauert 2minuten bis abgebrochen wird.
was möchte ich mit diesem code erreichen:
eine suche in tabelle vergleich (voiptarife nach ländern sortiert)
ich gebe zum beispiel deutschland ein und er soll mir alle einträge mit deutschland kopieren in tabelle
suchwerte.
ich zeig dir den original code den ich geändert habe weil er immer eine neue tabelle erstellt hat das brauch net daher habe ich es geändert.

Sub MultiSelect()
Dim wks As Worksheet
Dim rngFind As Range, rngRows As Range
Dim lngRow As Long
Dim strFind As String, strSearch As String
'suchbeginn
strSearch = InputBox("Suchbegriff:", , "Deutschland")
Set rngFind = Cells.Find(strSearch)
If rngRows Is Nothing Then
Set rngRows = rngFind
End If
If Not rngFind Is Nothing Then
strFind = rngFind.Address
Do
Set rngRows = Application.Union(rngRows, rngFind.EntireRow)
Set rngFind = Cells.FindNext(After:=rngFind)
If rngFind.Address = strFind Then Exit Do
Loop
End If
rngRows.Select
Selection.Copy
Cells(1, 1).Select
Sheets.Add
ActiveSheet.Name = "Suchwerte" & Sheets.Count
ActiveSheet.Paste
Cells(1, 1).Select
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
Application.CutCopyMode = False
End Sub


Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige