Clever-Excel-Forum › Office-Anwendungen › Excel v
Suchen und Markieren

Thema geschlossen 
Baumstrukturmodus
Suchen und Markieren
Arni49 Offline
Benutzer
Registriert seit: 16.12.2016
Version(en): 2013
#1
16.12.2016, 21:54
Ich bin neu hier im Forum und habe da mal eine Frage an die VBA Profis.
In meiner Excel Datei möchte ich mit einer Userfom all meine Tabellenblätter nach dem Suchwert in einer Inputbox durchsuchen. Die Suchergebnisse sollen in einer Listbox aufgelistet werden. Wenn ich dann in der Listbox ein Suchergebnis anklicke, soll zum einen die Zelle in meinen Tabellenblättern angezeigt werden und  farblich hervorgehoben werden. Sobald das nächste Ergebnis in der Listbox angeklickt wird soll aber die Letze Anwahl bzw. alle angeklickten Zellen wieder ihre Ursprungs Farbe bekommen.
Bin in VBA nicht so Firm, daher brauche ich Hilfe.
hier mal was ich schon zusammen bekommen habe:

Option Explicit

 Private Sub CommandButton1_Click()
    Dim myLookAt As XlLookAt, strFirstAddress As String, rngFound As Range   'hier wurde es gefunden
    
    If Len(TextBox1.Text) = 0 Then
       MsgBox "Suchtext eingeben"
       Exit Sub
    End If
   
    myLookAt = IIf(CheckBox1.Value, xlPart, xlWhole)
    With ActiveSheet.UsedRange
      
       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.AddItem rngFound.Address(0, 0)
          ListBox1.AddItem rngFound.Address(-1, 0)
          ListBox1.List(ListBox1.ListCount - 1, 1) = rngFound.Text
          Set rngFound = .FindNext(rngFound)
       Loop Until rngFound.Address(0, 0) = strFirstAddress
    End With
 End Sub

 Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    If ListBox1.ListIndex >= 0 Then
       ActiveSheet.Range(ListBox1.Value).Select
       ActiveCell.Interior.ColorIndex = 6
          
       Cancel = True
   
    End If
      
 End Sub
 
 
 Private Sub UserForm_Initialize()
    ListBox1.ColumnCount = 2
    ListBox1.BoundColumn = 1
    ListBox1.ColumnWidths = "0,150"
 End Sub
Private Sub CommandButton2_Click()                   ' damit bekomme ich beim verlassen nur die letzte Zelle wieder weis
ActiveCell.Interior.ColorIndex = 0
 UserForm2.Hide
End Sub
Suchen
Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#2
16.12.2016, 23:10
Hallo Arni,
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
   If ListBox1.ListIndex > -1 Then
      Cells.Interior.ColorIndex = 0
      Range(ListBox1.Value).Select
      ActiveCell.Interior.ColorIndex = 6
      Cancel = True
   End If
End Sub
Gruß Uwe
Suchen
Top
Arni49 Offline
Benutzer
ThreadStarter

Registriert seit: 16.12.2016
Version(en): 2013
#3
17.12.2016, 13:04
Hallo Uwe,
habe es geändert, jetzt werden allerdings alle Zellen der Tabellen weis und nicht nur die durch die Listbox angewählt.

Option Explicit

 Private Sub CommandButton1_Click()
    Dim myLookAt As XlLookAt, strFirstAddress As String, rngFound As Range   'hier wurde es gefunden
    
    If Len(TextBox1.Text) = 0 Then
       MsgBox "Suchtext eingeben"
       Exit Sub
    End If
   
    myLookAt = IIf(CheckBox1.Value, xlPart, xlWhole)
    With ActiveSheet.UsedRange
      
       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.AddItem rngFound.Address(2, 2)
          ListBox1.AddItem rngFound.Address(-1, 0)
          ListBox1.List(ListBox1.ListCount - 1, 1) = rngFound.Text
          Set rngFound = .FindNext(rngFound)
       Loop Until rngFound.Address(0, 0) = strFirstAddress
    End With
 End Sub

 Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    If ListBox1.ListIndex >= -1 Then
       Cells.Interior.ColorIndex = 0
       Range(ListBox1.Value).Select
       ActiveCell.Interior.ColorIndex = 6
               Cancel = True
   
    End If
      
 End Sub
 
 
 Private Sub UserForm_Initialize()
    ListBox1.ColumnCount = 2
    ListBox1.BoundColumn = 1
    ListBox1.ColumnWidths = "0,150"
 End Sub
Private Sub CommandButton2_Click()
 UserForm2.Hide
End Sub
Suchen
Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#4
17.12.2016, 13:20
Hallo Arni,

dann probiere es mal so:
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  If ListBox1.ListIndex > -1 Then
     If ListBox1.Tag <> "" Then Range(ListBox1.Tag).Interior.ColorIndex = 0
     Range(ListBox1.Value).Select
     ActiveCell.Interior.ColorIndex = 6
     ListBox1.Tag = ActiveCell.Address
     Cancel = True
  End If
End Sub

Private Sub CommandButton2_Click()
   If ListBox1.Tag <> "" Then Range(ListBox1.Tag).Interior.ColorIndex = 0
   UserForm2.Hide
End Sub

Übrigens ist
If ListBox1.ListIndex > -1
nicht dasselbe wie
If ListBox1.ListIndex >= -1 . Wink

Mit If ListBox1.ListIndex >= -1 kannst Du diese Abfrage auch gleich weglassen.

Gruß Uwe
[-] Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:
  • Arni49
Suchen
Top
Arni49 Offline
Benutzer
ThreadStarter

Registriert seit: 16.12.2016
Version(en): 2013
#5
17.12.2016, 23:49
Hallo Uwe,

Du hast natürlich Recht :) hätte wohl etwas genauer nachsehen müssen.
Jetzt Funzt es, Danke
Suchen
Top
Arni49 Offline
Benutzer
ThreadStarter

Registriert seit: 16.12.2016
Version(en): 2013
#6
26.12.2016, 22:14
Hallo,

habe da doch nochmal eine Frage.
Ich bräuchte in diesem Code noch eine Erweiterung:
zu der gefunden Zelle noch in der  Spalte die Zelle 1n Zeile 8
Und die beiden Werte aus der gleichen Zeile in Spalte 1+2.

Habe ein Bild zu Erläuterung angehangen.
In Spalte 1 sind die Stunden angaben für "20 und 40" nur durch gleiche Farbe ausgeblendet.
Suchen
Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#7
26.12.2016, 23:23
Hallo Arni,

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 = 0
     Cells(Range(ListBox1.Tag).Row, 2).Interior.ColorIndex = 0
   End If
   Range(ListBox1.Value).Select
   ActiveCell.Interior.ColorIndex = 6
   Cells(8, ActiveCell.Column).Interior.ColorIndex = 6
   Cells(ActiveCell.Row, 1).Interior.ColorIndex = 6
   Cells(ActiveCell.Row, 2).Interior.ColorIndex = 6
   ListBox1.Tag = ActiveCell.Address
   Cancel = True
 End If
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 = 0
   Cells(Range(ListBox1.Tag).Row, 2).Interior.ColorIndex = 0
 End If
 UserForm2.Hide
End Sub

Gruß Uwe
Suchen
Top
Arni49 Offline
Benutzer
ThreadStarter

Registriert seit: 16.12.2016
Version(en): 2013
#8
27.12.2016, 00:48
Hallo Uwe,
Super habe wieder etwas dazu gelernt.
Code:
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.AddItem rngFound.Address(2, 2)
          ListBox1.AddItem rngFound.Address(-1, 0)
          ListBox1.List(ListBox1.ListCount - 1, 1) = rngFound.Text
          Set rngFound = .FindNext(rngFound)
       Loop Until rngFound.Address(0, 0) = strFirstAddress
    End With
 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 = 10
    Cells(Range(ListBox1.Tag).Row, 2).Interior.ColorIndex = 3
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 ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 ' If ListBox1.ListIndex > -1 Then
  '   If ListBox1.Tag <> "" Then Range(ListBox1.Tag).Interior.ColorIndex = 0
   '  Range(ListBox1.Value).Select
    ' ActiveCell.Interior.ColorIndex = 4
     'ListBox1.Tag = ActiveCell.Address
 '    Cancel = True
  'End If
'End Sub
 
 
 Private Sub UserForm_Initialize()
    ListBox1.ColumnCount = 2
    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 = 0
End If
UserForm2.Hide
End Sub

Das funktioniert schon sehr gut, die anderen Zellen werden auch farblich gekennzeichnet.
Die Farben kann ich anpassen.

Jetzt wäre noch gut wenn die Listbox das auch noch anzeigen würde.
Suchen
Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#9
27.12.2016, 10:27
Hallo Arni,

(27.12.2016, 00:48)Arni49 schrieb: Das funktioniert schon sehr gut, die anderen Zellen werden auch farblich gekennzeichnet.
Die Farben kann ich anpassen.

Jetzt wäre noch gut wenn die Listbox das auch noch anzeigen würde.

Huh

Gruß Uwe
Suchen
Top
Arni49 Offline
Benutzer
ThreadStarter

Registriert seit: 16.12.2016
Version(en): 2013
#10
27.12.2016, 14:19
Hallo Uwe,

Vielleicht falsch ausgedrückt !

In der Listbox steht ja schon das Suchergebnis und die anderen Zellen werden farblich markiert, jetzt wäre es noch gut wenn auch der Inhalt der Zellen die farblich gekennzeichnet werden in der Listbox neben dem Suchergebnis aufgelistet würden.

So verständlicher ???

Danke für deine Hilfe
Suchen
Top
Thema geschlossen 


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste