AW: Suche mit Userform
04.10.2011 12:33:06
Tino
Hallo,
weiß jetzt nicht warum es bei Dir nicht ankommt,
habe die Datei nochmal runtergeladen ist alles enthalten.
Der Aufbau sieht so aus!
Die Userform
Code der Datei
kommt als Code in DieseArbeitsmappe
Option Explicit
Private Sub Workbook_Activate()
Application.OnKey "^%f", "Show_Suche"
End Sub
Private Sub Workbook_Deactivate()
Application.OnKey "^%f"
End Sub
kommt als Code in UserForm1
Option Explicit
Private Sub CommandButton1_Click()
Dim ArrayValue, nValue
nValue = TextBox1
If nValue <> "" Then
If IsNumeric(nValue) Then nValue = nValue * 1
Call SucheDaten(nValue, OptionButton2, ArrayValue)
ListBox1.Clear
If IsArray(ArrayValue) Then ListBox1.List = ArrayValue
End If
End Sub
Private Sub SucheDaten(nValue As Variant, booGesMappe As Boolean, ArrayRueck)
Dim rng As Range, n&, nC&, ArrayData, ArrayAusg()
Dim oWS As Worksheet
With ThisWorkbook
For Each oWS In .Worksheets
If booGesMappe Or (oWS.Name = .ActiveSheet.Name) Then
With oWS.UsedRange
For Each rng In .Columns
ArrayData = rng.Value
If Not IsArray(ArrayData) Then
ArrayData = rng.Resize(, 2)
Redim Preserve ArrayData(1 To Ubound(ArrayData), 1 To 1)
End If
For n = 1 To Ubound(ArrayData)
If ArrayData(n, 1) = nValue Then
Redim Preserve ArrayAusg(nC)
ArrayAusg(nC) = "'" & oWS.Name & "'!" & rng.Cells(n, 1).Address(0, 0)
nC = nC + 1
End If
Next n
Erase ArrayData
Next rng
End With
End If
Next oWS
End With 'ThisWorkbook
If nC > 0 Then ArrayRueck = ArrayAusg
End Sub
Private Sub ListBox1_Click()
If ListBox1.ListIndex > -1 Then
Application.Goto Range(ListBox1)
End If
End Sub
kommt als Code in Modul1
Option Explicit
Sub Show_Suche()
UserForm1.Show
End Sub
Suchergfebnis sollte so aussehen.
Gruß Tino