Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema ListBox
BildScreenshot zu ListBox ListBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen

Suche in mehreren Tabellblättern


Betrifft: Suche in mehreren Tabellblättern von: Friedl
Geschrieben am: 24.04.2017 11:41:12

Hallo Excel Experten,

Ich habe hier folgenden Code um in mehreren Tabellen zu suchen. Das funktioniert soweit gut. Mein Problem ist, wenn es mehrere Einträge gibt. Wie kann ich bei mehreren Treffern diese in einer Listbox anzeigen lassen und dann durch Doppelklick den entsprechenden Eintrag auswählen und in die Userform eintragen.

Danke für eure hilfe
Friedl

Private Sub CommandButton1_Click()
Dim strSuch As String, ws As Integer, rng As Range, strNeu As String
Else
Start:
Do
strSuch = ComboBox1.Text
If strSuch = "" Or Len(strSuch) = 0 Then Exit Sub
Loop While Len(strSuch) < 3
ws = 1
Do While ws <= Worksheets.Count
Sheets(ws).Select
Set rng = Cells.Find(What:=strSuch, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
If rng Is Nothing And ws = Worksheets.Count Then
strNeu = MsgBox("Keine Begriff gefunden!" & Chr(13) & "Möchten sie erneut suchen?", vbYesNo)
If strNeu = vbNo Then
Exit Sub
Else
GoTo Start
End If
ElseIf rng Is Nothing And ws < Worksheets.Count Then
ws = ws + 1
Else
Call CommandButton12_Click ' hiermit werden informationen in die Userform eingetragen
 funktioniert solange es nur einen treffer gibt
Exit Sub
End If
Loop
End If
End Sub

  

Betrifft: AW: Suche in mehreren Tabellblättern von: yummi
Geschrieben am: 24.04.2017 12:12:25

Hallo Friedl,

das kann nur für einen Treffer funktionieren, weil Du nach Aufruf deines CommandButton12 ein Exit Sub stehen hast, was einen Abbruch bewirkt. Nimm die Zeile raus und es passiert mehr, ob es dann das liefert, was Du wilslt, lasse ich mal dahingestellt.

By The way: Sehr schlechter Programmmierstil! Gewöhn dir so etwas wie GOTO ganz schnell wieder ab. Wenn überhaupt dann höchsten um Errorhandling abzufangen, aber nicht im normalen Code.

Gruß
yummi


  

Betrifft: AW: Suche in mehreren Tabellblättern von: Friedl
Geschrieben am: 24.04.2017 13:50:23

Hallo Yummi,

ich glaub ich habe mein problem nicht richtig beschrieben.

Ich habe mehrer Tabellenblätter mit Namen und Adressen und .....
Jetzt kann es natürlich vorkommen, dass ein Name mehrmals vorkommt.
In einem einzelnen Tabellenblatt suche ich mit folgendem Code und wenn es hier mehrere Treffer gibt werden diese in einer Listbox in meiner Userform angezeigt. Mit doppelklick kann ich den gewünschten Treffer auswählen und die Userform wird mit Daten gefüllt. In diesen Code möchte ich eben die Möglichkeit einbauen um die suche auch auf mehrer Tabellenblätter auszuweiten.

Private Sub CommandButton12_Click()
Dim ssearch As String
Dim firstAddress
Dim i As Integer

'Datensatz suchen

Worksheets(Me.TextBox21.Text).Select


If ComboBox1.Text = "" Then
MsgBox "Geben Sie bitte einen Suchbegriff ein !"
Exit Sub
Else

ssearch = ComboBox1.Text
Set rngFind = Columns("d:d").Find(What:=ssearch, LookAt:=xlWhole, LookIn:=xlValues)
If rngFind Is Nothing Then
If MsgBox("Dieser Datensatz existiert noch nicht !" & vbCrLf & vbCrLf & " Möchten Sie ihn jetzt neu anlegen ?", vbQuestion + vbYesNo, "Nachfragen") = vbNo Then
ComboBox1.Text = ""
ComboBox1.SetFocus
Exit Sub
Else
ComboBox1.SetFocus
End If

Else
i = 0
firstAddress = rngFind.Address
Do

ListBox1.AddItem
ListBox1.List(i, 0) = rngFind.Offset(0, -3).Value
ListBox1.List(i, 1) = rngFind.Offset(0, -2).Value
ListBox1.List(i, 2) = rngFind
ListBox1.List(i, 3) = rngFind.Offset(0, 1).Value
ListBox1.List(i, 4) = rngFind.Offset(0, 2).Value
ListBox1.List(i, 5) = rngFind.Offset(0, 3).Value
ListBox1.List(i, 6) = rngFind.Offset(0, 4).Value
ListBox1.List(i, 7) = rngFind.Offset(0, 5).Value
ListBox1.List(i, 8) = rngFind.Offset(0, 6).Value
ListBox1.List(i, 9) = rngFind.Offset(0, 7).Value

Set rngFind = Columns("d:d").FindNext(rngFind)

i = i + 1

Loop While Not rngFind Is Nothing And rngFind.Address <> firstAddress

End If
End If

If ListBox1.ListCount = 1 Then
TextBox1.Text = rngFind.Offset(0, -2).Value
TextBox2.Text = rngFind.Offset(0, 1).Value
TextBox3.Text = rngFind.Offset(0, 2).Value
TextBox4.Text = rngFind.Offset(0, 3).Value
TextBox5.Text = rngFind.Offset(0, 4).Value
TextBox6.Text = rngFind.Offset(0, 5).Value
TextBox7.Text = rngFind.Offset(0, 6).Value
TextBox8.Text = rngFind.Offset(0, 7).Value
TextBox9.Text = rngFind.Offset(0, 8).Value
TextBox10.Text = rngFind.Offset(0, 9).Value
TextBox11.Text = rngFind.Offset(0, 10).Value
TextBox12.Text = rngFind.Offset(0, 11).Value
TextBox13.Text = rngFind.Offset(0, 12).Value
TextBox14.Text = rngFind.Offset(0, 13).Value
TextBox15.Text = rngFind.Offset(0, 14).Value
TextBox16.Text = rngFind.Offset(0, 15).Value
TextBox17.Text = rngFind.Offset(0, -1).Value
TextBox18.Text = rngFind.Offset(0, 16).Value
TextBox19.Text = rngFind.Offset(0, 17).Value
TextBox20.Text = rngFind.Offset(0, 18).Value
ListBox1.Clear
End If
If TextBox16.Text <> "" Then
ReadFolder "N:\UK_Dokumentation\KRIPPE\Anmeldungen - kinder\" & Me.TextBox16.Text & "\" ' Ordner Inhalt in Listbox anzeigen Function ReadFolder
End If


  

Betrifft: AW: Suche in mehreren Tabellblättern von: yummi
Geschrieben am: 24.04.2017 14:06:35

Hallo Friedl,

Anstatt Worksheets(Me.TextBox21.Text).Select
kommt

dim wks as worksheet
dim wks as workbook

set wkb = ThisWorkbook
for i = 1 to wkb.sheets.count
set wks = wkb.sheets(i)
.
.
.dein Code
next i

das next i kommt dann hinter deinen jetzigen code

und anstatt Set rngFind = Columns("d:d").Find(What:=ssearch, LookAt:=xlWhole, LookIn:=xlValues)

kommt
Set rngFind = wks.Columns("d:d").Find(What:=ssearch, LookAt:=xlWhole, LookIn:=xlValues)

Ist ungetestet und nicht im Editor eingegeben, müsste aber so passen

Gruß
yummi


  

Betrifft: AW: Suche in mehreren Tabellblättern von: Friedl
Geschrieben am: 24.04.2017 14:49:42

Hallo Yummi,

habe alles so übernommen Next i zum Schluss vor End Sub gesetzt.
Jetzt kommt immer das Fenster "Datensatz existiert nicht..."

Habe mal die Datei hochgeladen.

https://www.herber.de/bbs/user/113075.xlsm

Private Sub CommandButton1_Click()
Dim ssearch As String
Dim firstAddress
Dim i As Integer
dim wks as worksheet
dim wks as workbook

set wkb = ThisWorkbook
for i = 1 to wkb.sheets.count
set wks = wkb.sheets(i)

If ComboBox1.Text = "" Then
MsgBox "Geben Sie bitte einen Suchbegriff ein !"
Exit Sub
Else

ssearch = ComboBox1.Text
Set rngFind = wks.Columns("d:d").Find(What:=ssearch, LookAt:=xlWhole, LookIn:=xlValues)
If rngFind Is Nothing Then
If MsgBox("Dieser Datensatz existiert noch nicht !" & vbCrLf & vbCrLf & " Möchten Sie ihn jetzt  _
neu anlegen ?", vbQuestion + vbYesNo, "Nachfragen") = vbNo Then
ComboBox1.Text = ""
ComboBox1.SetFocus
Exit Sub
Else
ComboBox1.SetFocus
End If

Else
i = 0
firstAddress = rngFind.Address
Do

ListBox1.AddItem
ListBox1.List(i, 0) = rngFind.Offset(0, -3).Value
ListBox1.List(i, 1) = rngFind.Offset(0, -2).Value
ListBox1.List(i, 2) = rngFind
ListBox1.List(i, 3) = rngFind.Offset(0, 1).Value
ListBox1.List(i, 4) = rngFind.Offset(0, 2).Value
ListBox1.List(i, 5) = rngFind.Offset(0, 3).Value
ListBox1.List(i, 6) = rngFind.Offset(0, 4).Value
ListBox1.List(i, 7) = rngFind.Offset(0, 5).Value
ListBox1.List(i, 8) = rngFind.Offset(0, 6).Value
ListBox1.List(i, 9) = rngFind.Offset(0, 7).Value

Set rngFind = Columns("d:d").FindNext(rngFind)

i = i + 1

Loop While Not rngFind Is Nothing And rngFind.Address <> firstAddress

End If
End If

If ListBox1.ListCount = 1 Then
TextBox1.Text = rngFind.Offset(0, -2).Value
TextBox2.Text = rngFind.Offset(0, 1).Value
TextBox3.Text = rngFind.Offset(0, 2).Value
TextBox4.Text = rngFind.Offset(0, 3).Value
TextBox5.Text = rngFind.Offset(0, 4).Value
TextBox6.Text = rngFind.Offset(0, 5).Value
TextBox7.Text = rngFind.Offset(0, 6).Value
TextBox8.Text = rngFind.Offset(0, 7).Value
TextBox9.Text = rngFind.Offset(0, 8).Value
TextBox10.Text = rngFind.Offset(0, 9).Value
TextBox11.Text = rngFind.Offset(0, 10).Value
TextBox12.Text = rngFind.Offset(0, 11).Value
TextBox13.Text = rngFind.Offset(0, 12).Value
TextBox14.Text = rngFind.Offset(0, 13).Value
TextBox15.Text = rngFind.Offset(0, 14).Value
TextBox16.Text = rngFind.Offset(0, 15).Value
TextBox17.Text = rngFind.Offset(0, -1).Value
TextBox18.Text = rngFind.Offset(0, 16).Value
TextBox19.Text = rngFind.Offset(0, 17).Value
TextBox20.Text = rngFind.Offset(0, 18).Value
ListBox1.Clear
End If
If TextBox16.Text <> "" Then
ReadFolder "N:\UK_Dokumentation\KRIPPE\Anmeldungen - kinder\" & Me.TextBox16.Text & "\" '  _
Ordner Inhalt in Listbox anzeigen Function ReadFolder
End If
Next i
End Sub



  

Betrifft: AW: Suche in mehreren Tabellblättern von: Friedl
Geschrieben am: 24.04.2017 14:58:51

Hallo Yummi,

Die entsprechende Userform findest Du unter Userform_Anmeldung.

Danke
LG
Friedl


  

Betrifft: AW: Suche in mehreren Tabellblättern von: Friedl
Geschrieben am: 25.04.2017 07:47:26

Hallo Yummi,

Die entsprechende Userform findest Du unter Userform_Anmeldung.

Danke
LG
Friedl


  

Betrifft: AW: Suche in mehreren Tabellblättern von: yummi
Geschrieben am: 25.04.2017 08:40:37

Hallo Friedl,

mal abgesehen davon, dass da noch ein Syntaxerror drin ist, was soll denn wann passieren?
Das sieht für mich so aus, als wenn Du das Rad neu erfinden wolltest.
z.B. Auto_Open gibt es schon, wenn du auf DieseArbeitsmappe1 klickst, gibt es eine Funktion Workbook_open, die vom System her aufgerufen wird, was dein Auto_open wohl abbilden soll.
Ich versteh noch nicht ganz dein Handling, was soll ich als Benutzer jetzt machen und wann kommt dann der Fehler?

Gruß
yummi


  

Betrifft: AW: Suche in mehreren Tabellblättern von: Friedl
Geschrieben am: 25.04.2017 08:59:31

Hallo Yummi,

Erstmal Danke dafür, dass Du dir überhaupt die Zeit nimmst.

Ich weiß das Teil ist noch nicht perfekt. Baue eine bestehendes Excelsheet gerade um, deshalb ist es ein wenig chaotisch. Was ich versuche umzusetzten ist folgendes.

Wenn du die Userform_Anmedungen startest gibt es die combobox "Name" orange hinterlegt. Wenn ich dort einen Namen eingebe und auf den Button suche drücke, sollen alle Tabellenblätter (2018,2019,...) durchsucht werden und bei einem Treffer die einzelnen Textboxen der Userfom füllen, bei mehreren Treffern werden dies in der Listbox aufgelistet und durch doppelclick der gewünschte Treffer ausgewählt und die Ueserform gefüllt.
Das funktioniert auch, wenn nur das derzeit aktive Tabellenblatt durchsucht wird.
Ich möchte aber das alle Tabellblätter durchsucht werden und bei mehreren Treffern diese in der Listbox angezeigt werden und ich dann natürlich einenauswählen kann und die Userform gefüllt wird.

Es geht mir nur um diese suchfunktion, denn rest werde ich dann Später umbauen, ergänzen und.....
Das wichtigste ist im moment die Suchfunktion über mehrere Tabellenblätter.

Danke
Lg
Friedl


  

Betrifft: AW: Suche in mehreren Tabellblättern von: yummi
Geschrieben am: 25.04.2017 09:43:39

Hallo Friedl,

du fängst in dem nicht sichtbaren Sheet Bewohnerliste an zu suchen, wen ndu das nciht willst, dann musst du noch eine if Abfrage so in der Art machen
if wks.name <> "Bewohnerliste" then innerhalb der for Schleife drum herum bauen

Ich habe dir für dich zur Ansicht eine 2. For-Schleife davor gesetzt (zum Debuggen, siehe Direktfenster, da gehen die Ausgaben hin), da siehst Du welche Tebellenblätter er durchsucht, die 1. For Schleife kannst Du dann entfernen, wenn Du es verstanden hast.

Private Sub CommandButton1_Click()
Dim ssearch As String
Dim firstAddress
Dim i As Integer
Dim wks As Worksheet
Dim wkb As Workbook
Dim tb As Integer
Set wkb = ThisWorkbook

If Me.ComboBox1.Text = "" Then
    MsgBox "Geben Sie bitte einen Suchbegriff ein !"
    Exit Sub
Else
    'nur für Debug Zwecke
    Debug.Print "Anzahl der Sheets : " & wkb.Sheets.Count
    For tb = 1 To wkb.Sheets.Count
        Set wks = wkb.Sheets(tb)
        Debug.Print wks.Name
        Set wks = Nothing
    Next tb
    'Debug Zwecke Ende
    For tb = 1 To wkb.Sheets.Count
        Set wks = wkb.Sheets(tb)
        Debug.Print wks.Name        'hier gibt er dir im Debug Direktfenster aus welches  _
Tabellenblatt gerade durchsucht wird
        ssearch = Me.ComboBox1.Text
        Set rngFind = wks.Columns("d:d").Find(What:=ssearch, LookAt:=xlWhole, LookIn:=xlValues)
        If rngFind Is Nothing Then
            If MsgBox("Dieser Datensatz existiert noch nicht !" & vbCrLf & vbCrLf & "  Möchten  _
Sie ihn jetzt neu anlegen ?", vbQuestion + vbYesNo, "Nachfragen") = vbNo Then
                Me.ComboBox1.Text = ""
                Me.ComboBox1.SetFocus
                Exit Sub
            Else
                Me.ComboBox1.SetFocus
            End If

        Else
            i = 0
            firstAddress = rngFind.Address
            Do
                With Me.ListBox1
                    .AddItem
                    .List(i, 0) = rngFind.Offset(0, -3).Value
                    .List(i, 1) = rngFind.Offset(0, -2).Value
                    .List(i, 2) = rngFind
                    .List(i, 3) = rngFind.Offset(0, 1).Value
                    .List(i, 4) = rngFind.Offset(0, 2).Value
                    .List(i, 5) = rngFind.Offset(0, 3).Value
                    .List(i, 6) = rngFind.Offset(0, 4).Value
                    .List(i, 7) = rngFind.Offset(0, 5).Value
                    .List(i, 8) = rngFind.Offset(0, 6).Value
                    .List(i, 9) = rngFind.Offset(0, 7).Value
                End With
                
                Set rngFind = wks.Columns("d:d").FindNext(rngFind)
            
                i = i + 1
            
            Loop While Not rngFind Is Nothing And rngFind.Address <> firstAddress

        End If
        Set wks = Nothing
    Next tb
  
    'was willst du hier machen?
    If Me.ListBox1.ListCount = 1 Then
        With Me
            .ListBox1.Text = rngFind.Offset(0, -2).Value
            .TextBox2.Text = rngFind.Offset(0, 1).Value
            .TextBox3.Text = rngFind.Offset(0, 2).Value
            .TextBox4.Text = rngFind.Offset(0, 3).Value
            .TextBox5.Text = rngFind.Offset(0, 4).Value
            .TextBox6.Text = rngFind.Offset(0, 5).Value
            .TextBox7.Text = rngFind.Offset(0, 6).Value
            .TextBox8.Text = rngFind.Offset(0, 7).Value
            .TextBox9.Text = rngFind.Offset(0, 8).Value
            .TextBox10.Text = rngFind.Offset(0, 9).Value
            .TextBox11.Text = rngFind.Offset(0, 10).Value
            .TextBox12.Text = rngFind.Offset(0, 11).Value
            .TextBox13.Text = rngFind.Offset(0, 12).Value
            .TextBox14.Text = rngFind.Offset(0, 13).Value
            .TextBox15.Text = rngFind.Offset(0, 14).Value
            .TextBox16.Text = rngFind.Offset(0, 15).Value
            .TextBox17.Text = rngFind.Offset(0, -1).Value
            .TextBox18.Text = rngFind.Offset(0, 16).Value
            .TextBox19.Text = rngFind.Offset(0, 17).Value
            .TextBox20.Text = rngFind.Offset(0, 18).Value
        End With
        Me.ListBox1.Clear
    End If
    If Me.TextBox16.Text <> "" Then
        ReadFolder "N:\UK_Dokumentation\KRIPPE\Anmeldungen - kinder\" & Me.TextBox16.Text & "\"  _
     ' Ordner Inhalt in Listbox anzeigen Function ReadFolder
    End If
End If
End Sub
Allerdings werden die Tabellenblätter nur so lange durchsucht, bis der suchbegriff gefunden wird. Du musst darauf achten, dass Du vollständig referenzierst, sonst wirst du auf arge Probleme laufen, da sonst nur immer das aktive Sheet referenziert wird und das willst Du ja nicht.
Schau dir das mal an, ob Du damit vom Verstehen her weiter kommst.

Gruß
yummi


  

Betrifft: Hier ein wenig Code von: Max2
Geschrieben am: 24.04.2017 12:28:30

Hallo,

yummi hat da vollkommen recht und ich will zum Problem gar
keine andere Antwort geben.

Jedoch habe ich hier einen Code der ähnliches tut wie deiner,
nur dass er in jedem Workbook und jedem Sheet sucht.

Schau dir den Code einfach mal an und versuche deinen dann ohne GoTo zu schreiben.
GoTo macht nur Probleme und vernichtet die Lesbarkeit deines Codes.

Sub Suchen()

'=========================================================

Dim WB  As Workbook
Dim WBA As Workbook

Dim strInbox    As String
Dim Wahl        As String

Dim zelle As Range

Dim intWks As Integer

Dim FirstAddress

Dim bln As Boolean

'=========================================================

Set WBA = ActiveWorkbook

strInbox = InputBox("Bitte einen Suchbegriff eingeben", "SUCHE")

If strInbox = "" Then

Exit Sub

End If

For Each WB In Workbooks
  WB.Activate
  
    For intWks = 1 To ActiveWorkbook.Sheets.Count
    
        With Worksheets(intWks).UsedRange
        Set zelle = .Find(strInbox, LookIn:=xlValues)
        
                If Not zelle Is Nothing Then
                    FirstAddress = zelle.Address
                    bln = True
                    
                    Do
                        Worksheets(intWks).Select
                        zelle.Select
                        Wahl = MsgBox("[ " & strInbox & " ] gefunden in: " & vbCr & vbCr & " _
Mappe: " & WB.Name & vbCr & "Tabelle: " & Worksheets(intWks).Name & vbCr & "Zelle: " & zelle.Address(0, 0) & vbCr & vbCr & "Weitersuchen?", vbYesNo)
                            
                            If Wahl = vbNo Then
                                Set zelle = Nothing
                                Exit Sub
                            End If
                            Set zelle = .FindNext(zelle)
                            
                    Loop While Not zelle Is Nothing And zelle.Address <> FirstAddress
                
                End If
                
        End With
        
    Next intWks
    
Next WB

If bln = False Then
    MsgBox "Der Suchbegriff [" & strInbox & "] wurde nicht gefunden."
End If

Set zelle = Nothing
WBA.Activate

End Sub



Beiträge aus den Excel-Beispielen zum Thema "Suche in mehreren Tabellblättern"