< návrat zpět

MS Excel


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

Zaslal/a 4.10.2016 16:26

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ěď >

#032965
avatar
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 Sub
Nezapomeň, ž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
#032968
avatar
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: zip32968_excel.zip (231kB, staženo 24x)
citovat
#032969
avatar
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 Sub
Máš tam zapnutý filtr pro 4 pole, to jsem musel v makru ošetřit...
P.citovat
#032970
avatar
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
#032971
avatar
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 Sub
P.citovat
#032972
avatar
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
#032983
avatar
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 Sub
Teď už bych ti měl jenom poslat číslo účtu :-D...
P.citovat
#032985
avatar
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
#032986
avatar
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 Sub
P.citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

odpocet a storno tl.

PavDD • 28.3. 8:53

odpocet a storno tl.

Začátečník • 26.3. 14:39

odpocet a storno tl.

PavDD • 26.3. 10:22

odpocet a storno tl.

elninoslov • 26.3. 7:50

odpocet a storno tl.

PavDD • 26.3. 7:26

odpocet a storno tl.

elninoslov • 25.3. 22:34

odpocet a storno tl.

Začátečník • 25.3. 15:09