Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.
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, 20: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
Antworten Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#2
16.12.2016, 22: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
Antworten Top
Arni49 Offline
Benutzer
ThreadStarter

Registriert seit: 16.12.2016
Version(en): 2013
#3
17.12.2016, 12: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
Antworten Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#4
17.12.2016, 12: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
Antworten Top
Arni49 Offline
Benutzer
ThreadStarter

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

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

Registriert seit: 16.12.2016
Version(en): 2013
#6
26.12.2016, 21: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
Antworten Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#7
26.12.2016, 22: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
Antworten Top
Arni49 Offline
Benutzer
ThreadStarter

Registriert seit: 16.12.2016
Version(en): 2013
#8
26.12.2016, 23: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
Antworten Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#9
27.12.2016, 09:27
Hallo Arni,

(26.12.2016, 23: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
Antworten Top
Arni49 Offline
Benutzer
ThreadStarter

Registriert seit: 16.12.2016
Version(en): 2013
#10
27.12.2016, 13: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
Antworten Top
Thema geschlossen 


Gehe zu:


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