MS Excel

mějme ve sloupci A vytvořený souhrn jedinečných hodnot ze sloupce E. potřebuji naprogramovat makro, které po spuštění vyfiltruje hodnotu A, na které budu stát kursorem, ve sloupci E

Zaslat odpověď >

Pavlus(4.10.2016 19:13)#032965

Např.:
Sub Filtr_dle_vybrane_bunky()

On Error Resume Next
ActiveSheet.ShowAllData

ActiveSheet.Range("$E$1:$E$10000").AutoFilter _
Field:=1, Criteria1:=ActiveCell.Value

End SubNezapomeň, že když budeš mít takto dva sloupce vedle sebe, tak při filtrování budeš skrývat data (řádky) z obou sloupců...
P.citovat

hankeys(4.10.2016 19:36)#032968

myslím, že tohle není ono...vkládám excel k lepšímu pochopení...dopracoval jsem se k tomuto kodu, kterej pouštím tím tlačítkem "graf a drawdown výběru kursor" kterej funguje skvěle, ale musím stát v tom sloupci K, kde chci filtrovat. Ale v tom sloupci jsou všechny řádky, tedy i duplicitní hodnoty.
Neduplicitní hodnoty mám vytaženy od pozice F14 a chtěl bych, aby ten filtr fungoval tak, že si stoupnu s kursorem na nějakou jedinečnou hodnotu od pozice F14 a tuto hodnotu to vyfiltruje v tom sloupci K

Sub drawdown2()

a = Cells(1, 4)
b = ActiveCell.Column - 7
ActiveSheet.Range("$H$1:$K" & a).AutoFilter Field:=b, Criteria1:=ActiveCell _
, Operator:=xlAnd

Range("J2:J" & a).SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("k2").Select
End Sub

Příloha: zip

32968_excel.zip (231kB, staženo 24x)

citovat

Pavlus(4.10.2016 20:23)#032969

Pro tvůj konkrétní případ by mělo fungovat takto upravené:
Sub Filtr_dle_vybrane_bunky_2()

On Error Resume Next
ActiveSheet.ShowAllData

ActiveSheet.Range("$H$1:$K$10000").AutoFilter _
Field:=4, Criteria1:=ActiveCell.Value

End SubMáš tam zapnutý filtr pro 4 pole, to jsem musel v makru ošetřit...
P.citovat

hankeys(4.10.2016 20:41)#032970

SUPER tohle funguje na jedničku...a kdybych to chtěl ještě vytunit tak, že když budu stát od pozice F14 tak filtruj v K, ale když budu stát na něčem ve sloupci H, tak filtruj v sloupci H a když na něčem I tak filtruj z I, a když na něčem v K, tak filtruj taky v K?citovat

Pavlus(4.10.2016 21:08)#032971

Ty jsi náročný zákazník :-).

Třeba takto:
Sub Filtr_dle_vybrane_bunky_3()
Dim pole_filtru As Byte

If ((ActiveCell.Column = 6) And (ActiveCell.Row >= 14)) Or (ActiveCell.Column = 11) Then
pole_filtru = 4
ElseIf ActiveCell.Column = 8 Then
pole_filtru = 1
ElseIf ActiveCell.Column = 9 Then
pole_filtru = 2
End If

If pole_filtru > 0 Then
On Error Resume Next
ActiveSheet.ShowAllData

ActiveSheet.Range("$H$1:$K$10000").AutoFilter _
Field:=pole_filtru, Criteria1:=ActiveCell.Value
End If

End SubP.citovat

hankeys(4.10.2016 21:36)#032972

funkční...už se blížíme do finále :)

potřeboval bych tam ještě přidat jednu věc - mějme textové pole, do kterého potřebuju vepsat hodnotu, která je zrovna vyfiltrovaná

a aby to nebylo tak jednoduché, pokud je vyfiltrováno něco z toho F14 dolů nebo z K, tak místo té hodnoty (čísla) tam vepiš takový text z G14 dolů, který obsahuje to vyfiltrované číslo - tzn. udělá to jakoby náhradu něco jako POZVYHLEDAT nebo jak je to vzoreccitovat

Pavlus(5.10.2016 11:31)#032983

Za předpokladu, že máš textové pole (v kódu název TextBox1) jako Ovládací prvek ActiveX (Vývojář / Vložit / Ovládací prvky ActiveX / Textové pole):
Sub Filtr_dle_vybrane_bunky_4()
Dim pole_filtru As Byte
Dim text_do_pole As String

If ((ActiveCell.Column = 6) And (ActiveCell.Row >= 14)) Or (ActiveCell.Column = 11) Then
pole_filtru = 4
text_do_pole = Application.WorksheetFunction.VLookup(ActiveCell.Value, Range("F14:G10000"), 2, False)
ElseIf ActiveCell.Column = 8 Then
pole_filtru = 1
text_do_pole = ActiveCell.Value
ElseIf ActiveCell.Column = 9 Then
pole_filtru = 2
text_do_pole = ActiveCell.Value
End If

If pole_filtru > 0 Then
On Error Resume Next
ActiveSheet.ShowAllData

ActiveSheet.Range("$H$1:$K$10000").AutoFilter _
Field:=pole_filtru, Criteria1:=ActiveCell.Value

ActiveSheet.TextBox1.Value = text_do_pole
End If

End SubTeď už bych ti měl jenom poslat číslo účtu :-D...
P.citovat

hankeys(5.10.2016 14:56)#032985

hezké hezké a vypadá to na jedno pivko :D...ještě prosím o drobnou změnu - když není vyfiltrováno nic, tak textové pole prázdné. Díky za ochotucitovat

Pavlus(5.10.2016 18:26)#032986

Za předpokladu, že se textové pole bude mazat pouze při spuštění tohoto konkrétního makra (ruční zrušení filtru uživatelem neřeším):
Sub Filtr_dle_vybrane_bunky_5()
Dim pole_filtru As Byte
Dim text_do_pole As String

If ((ActiveCell.Column = 6) And (ActiveCell.Row >= 14)) Or (ActiveCell.Column = 11) Then
pole_filtru = 4
text_do_pole = Application.WorksheetFunction.VLookup(ActiveCell.Value, Range("F14:G10000"), 2, False)
ElseIf ActiveCell.Column = 8 Then
pole_filtru = 1
text_do_pole = ActiveCell.Value
ElseIf ActiveCell.Column = 9 Then
pole_filtru = 2
text_do_pole = ActiveCell.Value
End If

If pole_filtru > 0 Then
On Error Resume Next
ActiveSheet.ShowAllData

ActiveSheet.Range("$H$1:$K$10000").AutoFilter _
Field:=pole_filtru, Criteria1:=ActiveCell.Value

ActiveSheet.TextBox1.Value = text_do_pole
Else
ActiveSheet.TextBox1.Value = ""
End If

End SubP.citovat

Téma: filtr z vybrané hodnoty v buňce

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje