Registriert seit: 16.12.2016
Version(en): 2013
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
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
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
Registriert seit: 16.12.2016
Version(en): 2013
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
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
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 .
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:1 Nutzer sagt Danke an Kuwer für diesen Beitrag 28
• Arni49
Registriert seit: 16.12.2016
Version(en): 2013
Hallo Uwe,
Du hast natürlich Recht :) hätte wohl etwas genauer nachsehen müssen.
Jetzt Funzt es, Danke
Registriert seit: 16.12.2016
Version(en): 2013
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.
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
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
Registriert seit: 16.12.2016
Version(en): 2013
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.
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
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.
Gruß Uwe
Registriert seit: 16.12.2016
Version(en): 2013
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
|