Suchen in allen Bereichen

[Arni49]

Hallo,

ich habe eine Terminplanung in Excel erstellt und versuche jetzt eine umfängliche Suche aufzubauen.
Meine Probleme momentan sind:
1. Statt die Anzeige der Zelle möchte ich das der Inhalt der gefundenen Zelle Angezeigt wird
2. Ab der 2. Tabelle Februar zeigt er mir falsche Ergebnisse im Bereich "Minute/Vorname" und "PLZ", wo eigentlich nichts angezeigt werden soll außer Ergebnisse aus der Tabelle "Patienten"
3. Wie kann ich einen Druckbefehl der gesuchten Termine mit einbringen.
4. Die gefundenen Ergebnisse werden zwar in der Tabelle angezeigt, brächte aber noch eine Farbliche Hervorhebung.


habe den Code angehangen.


Wäre Toll wenn mir jemand dabei helfen kann.

[BoskoBiati]

Hallo,

http://www.clever-excel-forum.de/thread-326.html
http://www.clever-excel-forum.de/thread-47.html

[Arni49]

Hallo,
habe die Datei etwas reduziert und im .xslb Format gespeichert damit sie die Gesamtkapazität von 2048 kB im Forum nicht übersteigt.

[BoskoBiati]

Hallo,

schöne Datei,  aber wo sind da Daten, speziell fehlerhafte??????

[Arni49]

Hallo,

wegen Datenschutz hatte ich keine Eintragungen übermittel.
Alle Patienten relevanten Daten habe ich jetzt gelöscht und den Terminplan gefüllt gelassen.

wie schon beschrieben:

Makro Suche alle startet Userform1 Suchmaske, Bilder im Anhang.

das sind meine Probleme
Suche zb. "Dinkler"
1. Statt die Anzeige der Zelle möchte ich das der Inhalt der gefundenen Zelle Angezeigt wird
2. Ab der 2. Tabelle Februar zeigt er mir falsche Ergebnisse im Bereich "Minute/Vorname" und "PLZ", wo eigentlich nichts angezeigt werden soll außer Ergebnisse aus der Tabelle "Patienten"
3. Wie kann ich einen Druckbefehl der gesuchten Termine mit einbringen.
4. Die gefundenen Ergebnisse werden zwar in der Tabelle angezeigt,  aber  eine Farbliche Hervorhebung wäre gut.
5. Alle Sontage in den Tabellen Jan-Dez sollen mit den dazugehörigen 6 Spalten ausgeblendet werden

Hoffe das jetzt genug Info da ist

[Arni49]

Hallo,
niemand der helfen kann ???

[WillWissen]

Hallo Arni,

fachlich werde ich dir nicht helfen können.

wegen Datenschutz hatte ich keine Eintragungen übermittel.

Alle Patienten relevanten Daten habe ich jetzt gelöscht und den Terminplan gefüllt gelassen.

Aber um auf Edgars Frage zurückzukommen: du brauchst (und sollst natürlich) keine sensiblen Daten veröffentlichen. Aber ich denke, dass eine Beispieldatei mit erfundenen Daten, reduziert auf 15-20 Datensätze und mit den angesprochenen fehlerhaften Daten beim Helfen helfen könnte.

[Arni49]

Ich habe doch eine Datei mit Daten mit gesendet ???

hier nochmal.

Das ist der Code um des es geht:

Option Explicit
Dim wks As Worksheet
Dim wkb1, wkb2 As Workbook
Dim XBlatt, wks2 As Worksheet
Dim XZeile As Long
Dim Suchart As String
Dim xOpt As Integer
Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
    Suchart = xlWhole
Else
    Suchart = xlPart
End If
End Sub
Private Sub CheckBox2_Click()
If CheckBox2.Value = True Then
    ComboBox1.Enabled = False
Else
    ComboBox1.Enabled = True
End If
End Sub
Private Sub CommandButton1_Click()
Dim xSuche, xAdresse, xErste As String
Dim y As Boolean
Dim arr() As Variant
Dim rng As Range
Dim iCounter, iRowU As Integer
ListBox1.Clear
xSuche = TextBox1.Value
If xSuche = "" Then
    MsgBox "Bitte erst einen Suchbegriff eingeben!", vbExclamation, "Achtung!"
    Exit Sub
End If
If ComboBox1.Value = "" And CheckBox2.Value = False Then
    MsgBox "Bitte geben Sie ein, wo der Begriff gesucht werden soll!", vbExclamation, "Achtung!"
    Exit Sub
End If

 " Es wird alles gefunden! aber in der Suche werden in der Listbox  nicht alle Monate gleich angezeigt ( es stehen rechts Namen wo die Felder leer sein sollten)

For iCounter = 1 To ThisWorkbook.Sheets.Count
    If CheckBox2.Value = True Or Worksheets(iCounter).Name = ComboBox1.Value Then
        Set rng = Worksheets(iCounter).Cells.Find _
            (xSuche, lookat:=Suchart, LookIn:=xlValues)
        If Not rng Is Nothing Then
            With Worksheets(iCounter)
                xErste = rng.Address(False, False)
                y = True
                Do Until xAdresse = xErste
                    ReDim Preserve arr(0 To 9, 0 To iRowU)
                    arr(0, iRowU) = .Name
                    arr(1, iRowU) = rng.Address(False, False)                       "An dieser Stell soll er mir den Inhalt anzeigen"
                    arr(2, iRowU) = .Cells(rng.Row, 1)
                    arr(3, iRowU) = .Cells(rng.Row, 2)
                    arr(4, iRowU) = .Cells(rng.Row, 3)
                    arr(5, iRowU) = .Cells(rng.Row, 4)
                    arr(6, iRowU) = .Cells(rng.Row, 5)
                    arr(7, iRowU) = .Cells(rng.Row, 6)
                    arr(8, iRowU) = .Cells(rng.Row, 7)
                    iRowU = iRowU + 1
                    Set rng = .Cells.FindNext(after:=rng)
                    xAdresse = rng.Address(False, False)
                Loop
                xAdresse = ""
                xErste = ""
            End With
        End If
    End If
Next iCounter
If y = False Then
    MsgBox "Der Suchbegriff wurde nicht gefunden!"
Else
    ListBox1.Column = arr
End If
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub CommandButton3_Click()
Dim iCounter, xCounter As Long
Set wkb1 = ThisWorkbook
Set wkb2 = Workbooks.Add(1)
Set wks2 = wkb2.Sheets(1)
wkb1.Activate
For iCounter = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(iCounter) And xOpt = 1 Or xOpt = 2 Then
        Set XBlatt = Sheets(ListBox1.List(iCounter, 0))
        XZeile = Range(ListBox1.List(iCounter, 1)).Row
        xCounter = xCounter + 1
        XBlatt.Rows(XZeile).Copy wks2.Rows(xCounter)
    End If
Next iCounter
wks2.Activate
End Sub
Private Sub CommandButton4_Click()
Dim iCounter, xCounter As Long
Set wkb1 = ThisWorkbook
Set wkb2 = Workbooks.Add(1)
Set wks2 = wkb2.Sheets(1)
wkb1.Activate
For iCounter = ListBox1.ListCount - 1 To 0 Step -1
    If ListBox1.Selected(iCounter) And xOpt = 1 Or xOpt = 2 Then
        Set XBlatt = Sheets(ListBox1.List(iCounter, 0))
        XZeile = Range(ListBox1.List(iCounter, 1)).Row
        xCounter = xCounter + 1
        XBlatt.Rows(XZeile).Copy wks2.Rows(xCounter)
        XBlatt.Rows(XZeile).Delete Shift:=xlUp
        ListBox1.RemoveItem (iCounter)
    End If
Next iCounter
wks2.Activate
End Sub
Private Sub CommandButton5_Click()
Dim iCounter As Long
If MsgBox("Die markierten Daten werden unwideruflich aus dieser Datei gelöscht." & vbLf & _
            "Wollen Sie fortfahren?", vbOKCancel, "Achtung!") = vbOK Then
    For iCounter = ListBox1.ListCount - 1 To 0 Step -1
        If ListBox1.Selected(iCounter) And xOpt = 1 Or xOpt = 2 Then
            Set XBlatt = Sheets(ListBox1.List(iCounter, 0))
            XZeile = Range(ListBox1.List(iCounter, 1)).Row
            XBlatt.Rows(XZeile).Delete Shift:=xlUp
            ListBox1.RemoveItem (iCounter)
        End If
    Next iCounter
End If
End Sub

Private Sub Label7_Click()
End Sub

" In diesem Bereich brauche ich noch eine Kennzeichnung für die per Doppelklick angesprungenen Zellen""

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Application.GoTo Sheets(ListBox1.List(ListBox1.ListIndex, 0)).Range(ListBox1.List(ListBox1.ListIndex, 1))
End Sub




Private Sub OptionButton1_Click()
xOpt = 1
End Sub
Private Sub OptionButton2_Click()
xOpt = 2
End Sub
Private Sub UserForm_Initialize()
For Each wks In Worksheets
    If wks.Name <> ActiveSheet.Name Then ComboBox1.AddItem wks.Name
Next
Suchart = xlPart
xOpt = 1
End Sub

[schauan]

Hallöchen,

erst mal zu 3 der 6 Punkte.

**************************************************

" Es wird alles gefunden! aber in der Suche werden in der Listbox nicht alle Monate gleich angezeigt ( es stehen rechts Namen wo die Felder leer sein sollten)

Ich denke, Du meinst damit das:
2. Ab der 2. Tabelle Februar zeigt er mir falsche Ergebnisse im Bereich "Minute/Vorname" und "PLZ", wo eigentlich nichts angezeigt werden soll außer Ergebnisse aus der Tabelle "Patienten"

Hm. Das kommt mir auch sonst komisch vor. Es wird eben überall nach den Suchbegriffen gesucht und dann immer wieder der Inhalt aus den Spalten A bis G übernommen --> .Cells(rng.Row, 1) bis .Cells(rng.Row, 7) Müsste das nicht im Prinzip nach unten gehen? Also z.B. .Cells(1, rng.Column) ? Natürlich dann etwas mehr als 1 als Startzeile

**************************************************

arr(1, iRowU) = rng.Address(False, False) "An dieser Stell soll er mir den Inhalt anzeigen"

Damit ist bestimmt das gemeint?
1. Statt die Anzeige der Zelle möchte ich das der Inhalt der gefundenen Zelle Angezeigt wird

Der Inhalt einer Zelle? Welcher Zelle? Wie das geht, steht ja eine Zeile tiefer: arr(2, iRowU) = .Cells(rng.Row, 1) Hier wird der Inhalt der Zelle in Spalte A in das Array übernommen und nicht angezeigt. Die Ausgabe in der Listbox erfolgt weiter unten: ListBox1.Column = arr
Allerdings hast Du in Deiner Listbox als Überschrift "Zelle" und von daher gesehen passt es doch?

**************************************************

" In diesem Bereich brauche ich noch eine Kennzeichnung für die per Doppelklick angesprungenen Zellen""

Ich nehme an, dass ist der Punkt:
4. Die gefundenen Ergebnisse werden zwar in der Tabelle angezeigt, aber eine Farbliche Hervorhebung wäre gut.
Die Stelle hattest Du weiter oben mit arr(1, iRowU) = rng.Address(False, False) in Dein Array übernommen. Zwischen zwei Makros wäre die Frage, in welcher Form das wo passieren soll. Du könntest z.B. dort im code mit rng.interior.color oder colorindex arbeiten. Allerdings müssten die Farben auch irgendwann wieder raus, was meinst Du, wann?

**************************************************

[Arni49]

Hallo,

danke das Du dir angesehen hast.

Habe aber mittlerweile nochmal komplett von vorne begonnen und etwas anderes erstellt.

Danke das Du dir die Mühe gemacht hast es dir anzusehen.

Bei der neuen Suche  wird mir alles soweit angezeigt und auch in der Tabelle bei Doppelklick gekennzeichnet.

Ich bin gerade dran das diese Userform eine Tabellenauswahl bekommt und ich somit gezielt darin suchen kann.

Des Weiteren bin ich noch an einer Lösung dran wie ich mir per Auswahl die Leeren Zellen(wo Freie Termine bei welchem Therapeut mit Zeit und Datum sind) in der Userform anzeigen lassen kann.

Falls Du Lust hast schau doch mal drüber.

Code:

Option Explicit




Private Sub CommandButton1_Click()
   Dim myLookAt As XlLookAt, strFirstAddress As String, rngFound As Range   'Suchart, Erste Adresse als Zeichenfolge, Bereich
   
   If Len(TextBox1.Text) = 0 Then    'Textbox leer ??
      MsgBox "Suchtext eingeben"
      Exit Sub
   End If
   
   myLookAt = IIf(CheckBox1.Value, xlPart, xlWhole)    'Suchart XLPART Teilergebnis, XLWhole Exakte Suche
   With ActiveSheet.UsedRange                          'Benutzer Bereich in der Aktiven Tabelle
     
      Set rngFound = .Find(What:=TextBox1.Text, LookIn:=xlValues, LookAt:=myLookAt)
      If rngFound Is Nothing Then
         MsgBox "Keine Termine vorhanden"
         Exit Sub
      End If
   
      ListBox1.Clear
      strFirstAddress = rngFound.Address(0, 0)
      Do
        ListBox1.ColumnWidths = "0cm;6cm;1cm;1cm;3cm;3cm;3cm;3cm"   ' Breite der Spalte
        ListBox1.AddItem rngFound.Address(-1, 0)
         ListBox1.AddItem rngFound.Address(0, 0)
           ListBox1.List(ListBox1.ListCount - 1, 1) = rngFound.Text        ' Name
           ListBox1.List(ListBox1.ListCount - 1, 2) = Cells(rngFound.Row, 1).Text      ' Stunde
           ListBox1.List(ListBox1.ListCount - 1, 3) = Cells(rngFound.Row, 2).Text      ' Minute
           ListBox1.List(ListBox1.ListCount - 1, 4) = Cells(8, rngFound.Column).Text   'Therapeut
           ListBox1.List(ListBox1.ListCount - 1, 5) = Cells(rngFound.Row - 1, rngFound.Column).Text 'Behandlung
           ListBox1.List(ListBox1.ListCount - 1, 6) = Cells(2, rngFound.Column).Text  'Tag
           ListBox1.List(ListBox1.ListCount - 1, 7) = Cells(4, rngFound.Column).Text  'Tag
         Set rngFound = .FindNext(rngFound)
      Loop Until rngFound.Address(0, 0) = strFirstAddress
   End With
End Sub

Private Sub CommandButton3_Click()

Dim zeLB As Long, spLB As Long
Dim zeTB As Long, spTB As Long
Dim allesDrucken As Boolean

' Zellen leeren

Range("Druckvorlage!A2:P1000") = ""
   
' Querformat festlegen
Worksheets("Druckvorlage").PageSetup.Orientation = xlLandscape
   
'--- Drucker auswählen
Application.Dialogs(xlDialogPrinterSetup).Show

'-- Prüfen, ob alles gedruckt werden muss
For zeLB = 0 To ListBox1.ListCount - 1
    allesDrucken = allesDrucken Or ListBox1.Selected(zeLB)
Next
zeTB = 1
'--- selektierte Listboxeinträge in Zellen schreiben
For zeLB = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(zeLB) Or Not allesDrucken Then
        zeTB = zeTB + 1
        For spLB = 1 To ListBox1.ColumnCount - 1
            Sheets("Druckvorlage").Cells(zeTB, spLB + 1) = ListBox1.List(zeLB, spLB)
       
        Next
    End If
Next

ThisWorkbook.Unprotect Password:="olli3301"
Sheets("Druckvorlage").Visible = True

' Drucke Tabellenblatt
Worksheets("Druckvorlage").PrintOut

   Sheets("Druckvorlage").Visible = False
ThisWorkbook.Protect Password:="olli3301"
End Sub




Private Sub Label10_Click()

End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
   If ListBox1.ListIndex > -1 Then
   If ListBox1.Tag <> "" Then
   Range(ListBox1.Tag).Interior.ColorIndex = 0
   Cells(8, Range(ListBox1.Tag).Column).Interior.ColorIndex = 0
   Cells(Range(ListBox1.Tag).Row, 1).Interior.ColorIndex = 43
   Cells(Range(ListBox1.Tag).Row, 2).Interior.ColorIndex = 19
End If
   Range(ListBox1.Value).Select
   ActiveCell.Interior.ColorIndex = 4
   Cells(8, ActiveCell.Column).Interior.ColorIndex = 4
   Cells(ActiveCell.Row, 1).Interior.ColorIndex = 4
   Cells(ActiveCell.Row, 2).Interior.ColorIndex = 4
   ListBox1.Tag = ActiveCell.Address
   Cancel = True
   End If
End Sub
 
Private Sub UserForm_Initialize()
  ListBox1.ColumnCount = 8   ' Anzahl der Spalten
   ListBox1.BoundColumn = 1
   ListBox1.ColumnWidths = "0,150"
   
End Sub

Private Sub CommandButton2_Click()
If ListBox1.Tag <> "" Then
Range(ListBox1.Tag).Interior.ColorIndex = 0
Cells(8, Range(ListBox1.Tag).Column).Interior.ColorIndex = 0
Cells(Range(ListBox1.Tag).Row, 1).Interior.ColorIndex = 43
Cells(Range(ListBox1.Tag).Row, 2).Interior.ColorIndex = 19
End If
UserForm2.Hide
End Sub