Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
408to412
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
408to412
408to412
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Suche in einem Worksheet

Suche in einem Worksheet
Erich
Hallo EXCEL-Freunde,
habe mit Hilfe des Forums eine UserForm mit einem Code erstellt, der mir
in allen Tabellen ein Wort sucht. Nun scheitere ich daran, dass die Suche
nur in einem Worksheet (mit ComboBox definiert als: myName1) erfolgt.
Hier mein derzeitiger Code (leider funktioniert meine Jeanie nicht richtig?):
Sub Muster() <a href="'https://www.herber.de/forum/archiv/224to228/t225904.htm">'https://www.herber.de/forum/archiv/224to228/t225904.htm</a>
'Re: suchen und kopieren ' mehrmals geändert Erich M. sFind = myWert1 ' = Auswahl in ComboBox oder über: InputBox("Bitte Suchbegriff eingeben:") If sFind = "" Then Exit Sub mySpalte = mySpalte '= Auswahl in ComboBox oder über: InputBox("Bitte Spalte eingeben:") 'If mySpalte = "" Then Exit Sub tarWks = "Gefunden" ' Zieltabelle Cr = 65536 If Worksheets(tarWks).Cells(Cr, 1) = "" Then Cr = Worksheets(tarWks).Cells(Cr, 1).End(xlUp).Row End If If Cr = 2 Then Cr = 3 For Each wks In Worksheets 'nur Suche in einer Tabelle in mySpalte; Tabelle = myName1 (Auswahl per ComboBox) If wks.Name = tarWks Then GoTo Exitfor Set rng = wks(myName1).Columns(mySpalte).Find(what:=sFind, _ lookat:=xlWhole, LookIn:=xlValue) 'xlFormulas If Not rng Is Nothing Then sAddress = rng.Address Do Application.Goto rng, True ' If MsgBox("Weiter und kopieren", vbYesNo + vbQuestion) = vbNo Then Exit Sub wks.Rows(rng.Row).Copy Destination:=Worksheets(tarWks).Rows(Cr) wks.Rows(rng.Row).Copy 'neu Worksheets(tarWks).Rows(Cr).PasteSpecial Paste:=xlValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'neu Application.CutCopyMode = False 'neu Cr = Cr + 1 Set rng = Columns(mySpalte).Cells.FindNext(after:=ActiveCell) If rng.Address = sAddress Then Exit Do Loop End If Exitfor: Next wks End Sub
Besten Dank für eine Hilfe!
mfg
Erich

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Suche in einem Worksheet
Nepumuk
Guten Morgen Erich,
Ich komme mit deiner Frage nicht ganz klar. Soll der Code nur in der Tabelle myName1 suchen, oder in allen Tabelle außer "Gefunden"?
Gruß
Nepumuk
AW: Suche in einem Worksheet
Erich
Hallo Nepumuk,
der Code soll nur in der Tabelle myName1 suchen;
ferner grenze ich die Suche auf mySpalte ein.
mfg
Erich
AW: Suche in einem Worksheet
Nepumuk
Hallo Erich,
versuch es mal so:

Set rng = wks(myName1).Columns(mySpalte).Find(what:=sFind, lookat:=xlWhole, LookIn:=xlValue) 'xlFormulas
If Not rng Is Nothing Then
    sAddress = rng.Address
    Do
        Application.Goto rng, True
'        If MsgBox("Weiter und kopieren", vbYesNo + vbQuestion) = vbNo Then Exit Sub
        wks.Rows(rng.Row).Copy Destination:=Worksheets(tarWks).Rows(Cr)
        wks.Rows(rng.Row).Copy                                          'neu
        Worksheets(tarWks).Rows(Cr).PasteSpecial Paste:=xlValues, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False          'neu
        Application.CutCopyMode = False                                 'neu
        Cr = Cr + 1
        Set rng = wks(myName1).Columns(mySpalte).FindNext(after:=ActiveCell)
        If rng.Address = sAddress Then Exit Do
    Loop
End If

Gruß
Nepumuk
Anzeige
AW: Suche in einem Worksheet
Erich
Hallo Nepumuk,
erhalte leider Fehlermeldung:
Laufzeitfehler 91
Objektvariable oder With-Blockvariable nicht festgelegt
Dabei habe ich den geänderten Code nach
If Cr = 2 Then Cr = 3
eingesetzt.
mfg
Erich
AW: Suche in einem Worksheet
Nepumuk
Hallo Erich,
ich hätte die zweite Tasse Kaffee doch erst trinken sollen, bevor ich mich an den Rechner setze. Eigefügt hast du das schon richtig, aber ich habe übersehen, dass du die Variable öfters benutzt. So geht's:

Set wks = Worksheets(myName1)
Set rng = wks.Columns(mySpalte).Find(what:=sFind, lookat:=xlWhole, LookIn:=xlValue) 'xlFormulas
If Not rng Is Nothing Then
    sAddress = rng.Address
    Do
        Application.Goto rng, True
'        If MsgBox("Weiter und kopieren", vbYesNo + vbQuestion) = vbNo Then Exit Sub
        wks.Rows(rng.Row).Copy Destination:=Worksheets(tarWks).Rows(Cr)
        wks.Rows(rng.Row).Copy                                          'neu
        Worksheets(tarWks).Rows(Cr).PasteSpecial Paste:=xlValues, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False          'neu
        Application.CutCopyMode = False                                 'neu
        Cr = Cr + 1
        Set rng = wks.Columns(mySpalte).FindNext(after:=ActiveCell)
        If rng.Address = sAddress Then Exit Do
    Loop
End If

Gruß
Nepumuk
Anzeige
..noch nicht ganz..
Erich
Hallo Nepumuk,
erhalte die Fehlermeldung:
Laufzeitfehler 9
Index außerhalb des gültigen Bereichs
In der gelben Zeile Set rng = wks.Columns.....
wird bei mySpalte (=1) angezeigt (weil ich Spalte A auswähle; bei wks kommt kein
Fehlerhinweis).
Ich wechsle auch nicht zwischen einer Datei.
Mein Einstieg geschieht aber so:
1. ComboBox1: Auswahl Tabelle1 (=Suchtabelle)
2. myName1 = ComboBox1.Text
3. Set wks = Worksheets(myName1)
Habe mal myName1 mit ComboBox1.Text ausgetauscht - gleiche Fehlermeldung.
Gibts da vielleicht eine Falle?
Besten Dank!
mfg
Erich
Anzeige
AW: ..noch nicht ganz..
Nepumuk
Hallo Erich,
ich habe das mal versuch nachzubauen, das funktioniert.


Public Sub test()
Dim wks As Worksheet, rng As Range, sAddress As String, sFind As String, mySpalte As Integer
Dim myName1 As String
mySpalte = 1
myName1 = "Tabelle1"
sFind = "x"
Set wks = Worksheets(myName1)
Set rng = wks.Columns(mySpalte).Find(what:=sFind, lookat:=xlWhole, LookIn:=xlValue) 'xlFormulas
If Not rng Is Nothing Then
    sAddress = rng.Address
    Do
        Application.Goto rng, True
'        If MsgBox("Weiter und kopieren", vbYesNo + vbQuestion) = vbNo Then Exit Sub
'        wks.Rows(rng.Row).Copy Destination:=Worksheets(tarWks).Rows(Cr)
'        wks.Rows(rng.Row).Copy                                          'neu
'        Worksheets(tarWks).Rows(Cr).PasteSpecial Paste:=xlValues, _
'        Operation:=xlNone, SkipBlanks:=False, Transpose:=False          'neu
'        Application.CutCopyMode = False                                 'neu
'        Cr = Cr + 1
        Set rng = wks.Columns(mySpalte).FindNext(after:=ActiveCell)
        If rng.Address = sAddress Then Exit Do
    Loop
End If
End Sub


Prüfe nochmal den Inhalt der Variablen, ob da nicht der Wurm drin ist.
Gruß
Nepumuk
Anzeige
DANKE - Nepumuk; Jetzt perfekt wie immer - o.T.!!
Erich
.

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige