timmo1 ...díky za odpovede ale skôr by som potreboval také niečo ako automatický filter, kde by som klikol na nejaké vytvorené tlačítko, potom by sa mi ukázal riadok, kde by som napísal hodnotu a tento filter by mi nechal len jeden celý riadok s touto hodnotou, Aby som nemusel hľadať v tom rolovacom zozname pri zapnutom filtri.....
Najjednoduchší spôsob je kombináciou Validácie hodnôt v bunke a funkcie VLOOKUP. Príkladov na VLOOKUP tu už bolo milión, v kombinácii s validáciou napr. tu:
http://www.porada.sk/993274-post2.html
Dá sa to i inak, ale je to trošku komlikovanejšie.
(príklad ako sa to dá použiť v praxi viď prílohu)
Príklad na to, že chceš do poľa i písať i vyberať zo zoznamu
1) Zapnúť toobar "
Ovládacie prvky"
2) Pridať pole typu "
Rozbaľovacie pole"
3) Vo VBA kóde treba pre príslušný prvok pridať dva typy funkcií
a) _
GotFocus - spustí sa keď vstúpiš do prvku - naplnenie hodnôt pre rozbaľovací zoznam
b)
_KeyDown - spustí sa po stlačení prísl klávesy napr. ENTER - spustí autofilter alebo inú funkčnosť.
GOT FOCUS
-------------
Private Sub k_FindProjPopis_GotFocus()
Call f_FindXXXGotFocus("k__Popis", "k_FindProjPopis")
End Sub
Public Sub f_FindXXXGotFocus(x__RngName As String, xCtlName As String)
Dim a As Range
Dim xArrK() As Variant
Dim ObjCombo
On Error GoTo errHndl
'naplnenie hodnot pre zoznam
Set a = Range(x__RngName)
xArrK = a.Value
Set ObjCombo = Sheets(a.Parent.Name).OLEObjects(xCtlName).Object
ObjCombo.Clear
ObjCombo.List() = xArrK
errRes:
Set a = Nothing
Set ObjCombo = Nothing
Exit Sub
errHndl:
MsgBox Err.Description
GoTo errRes
End Sub
KEY DOWN
-------------
Private Sub k_FindProjPopis_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Call f_FindXXXKeyDown(KeyCode, "k__Popis", "k_FindProjPopis")
End Sub
Public Sub f_FindXXXKeyDown(ByVal KeyCode As Integer, x__RngName As String, xCtlName As String)
Dim xx As String, ErrorHandler
Dim ObjCombo
Dim a As Range
If KeyCode = 13 Or KeyCode = 9 Then
On Error GoTo ErrorHandler
Set a = Range(x__RngName)
Set ObjCombo = Sheets(a.Parent.Name).OLEObjects(xCtlName).Object
xx = ObjCombo.Value
If xx = "... hľadať" Then Exit Sub
If x__RngName = "k__Popis" Then
'upravene pre filter
a.Cells(1).Select
Selection.AutoFilter Field:=4, Criteria1:=xx ' napr. "dsl"
Else
'povodne - hladanie
a.Find(What:=xx, LookAt:=xlPart).Activate
End If
xResume1:
ObjCombo.Value = xx
xResume2:
Set a = Nothing
Set ObjCombo = Nothing
Exit Sub
ErrorHandler:
If xx = "... hľadať" Then
GoTo xResume2
Else
MsgBox ("Text '" & xx & "' som nenašiel")
xx = "... hľadať"
GoTo xResume1
End If
End If
End Sub
Palo