MS Excel

Zdravim,
Chci se zeptat jestli nekdo dokaze upravit toto makro tak aby prepocitalo jen zafiltrovanou oblats nic jineho. Nyni se vypocet znici..
viz priloha:

Sub FILTR()

Dim MaxRadek As Long
Dim OblastA As Range

Application.ScreenUpdating = False

MaxRadek = List1.Cells(Rows.Count, 4).End(xlUp).Row

Set OblastA = Range("E7:E" & MaxRadek)

With OblastA
.FormulaLocal = "=D7+$E$5"
.Value = .Value
End With

Application.ScreenUpdating = True

Set OblastA = Nothing

End Sub

Zaslat odpověď >

Stalker(14.3.2020 16:11)#046207

Jen nástřel pomocí cyklu. viz soubor.
První kód mi funguje pokud se vyfiltruje číslo 1, při další hodnotě hodí chybu, zatím nevím proč kua

.
Možná se chytne někdo další a zbavíš se toho cyklu.

Příloha: rar

46207_filtr.rar (17kB, staženo 20x)

citovat

Merlin99(14.3.2020 18:46)#046208

Stalker:
makro FILTR2 je presne onooo a funguje dokonale, použuju.
DĚKUJI mooc za pomoc

citovat

Merlin99(14.3.2020 19:36)#046209

Škoda že se nepovedlo aby makro mohlo obsahovat lokalni funkci. Slozity megavzorce se snadneji delaji za pomoci lokalnich funkcích(ty se pak jen vlozi) nez to lustit ve VBA. Treba se to nekomu povede doladit k dokonalosti jeste.

citovat

elninoslov(16.3.2020 2:32)#046211

Pokus:
Sub FILTR3()
Dim MaxRadek As Long
Dim OblastA As Range
Dim Vzorec As String

Application.ScreenUpdating = False

MaxRadek = List1.Cells(Rows.Count, 4).End(xlUp).Row

Set OblastA = Range("E7:E" & MaxRadek).SpecialCells(xlCellTypeVisible)

Vzorec = "=D•+$E$5"
With OblastA
.FormulaLocal = Replace(Vzorec, "•", .Row)
.Value = .Value
End With

Application.ScreenUpdating = True

Set OblastA = Nothing

End Sub
Znak "•" nahradzuje vo vzorci relatívnu pozíciu, ktorá sa naraz nahradí za riadok prvej bunky, ktorá je vyfiltrovaná, ostatné si už potom Excel vyplní. Ak máte vo vzorci odkazy na viac relatívnych buniek rôznych riadkov, nájdite si teda ďalšie znaky (reťazce), ktorými ich nahradíte. Musel by som vidieť reálny vzorec a rozmiestnenie.

PS: Ak by išlo iba o pripočítanie nejakého čísla, tak stačí :
With List1
.Range("E5").Copy
.Range("E7", .Cells(Rows.Count, 4).End(xlUp)).SpecialCells(xlCellTypeVisible).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks:=False, Transpose:=False
End Withcitovat

elninoslov(17.3.2020 2:00)#046213

Oprava, musí sa to urobiť po oblastiach:
Sub FILTR4()
Dim i As Long
Dim ARE As Range
Dim Vzorec As String

Application.ScreenUpdating = False

Vzorec = "=D•+$E$5"
With List1
For Each ARE In .Range("E7", .Cells(Rows.Count, 5).End(xlUp)).SpecialCells(xlCellTypeVisible).Areas
With ARE
.FormulaLocal = Replace(Vzorec, "•", .Row)
.Value = .Value
End With
Next ARE
End With

Application.ScreenUpdating = True
Set ARE = Nothing
End Subcitovat

Merlin99(17.3.2020 22:40)#046215

elninoslov
Děkuji za pomoc, nicméně tomu moc nerozumím protože asi něco delam spatne a netusim co. viz pokus tveho reseni na dalsim prikladu abych to pochopil ale vraci to chyby.

Příloha: rar

46215_filtr.rar (17kB, staženo 14x)

citovat

elninoslov(18.3.2020 1:36)#046216

Úprava:
Sub FILTR4()
Dim i As Long
Dim ARE As Range
Dim Vzorec As String

Application.ScreenUpdating = False

'CZ
'Vzorec = "=SVYHLEDAT(List1!D•;List2!$B:$C;2;0)"

'SK
Vzorec = "=VLOOKUP(List1!D•;List2!$B:$C;2;0)"

With List1
'Projde všechny vyfiltrované spojité podoblasti - Areas
For Each ARE In .Range("E7:E" & .Cells(Rows.Count, 4).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Areas
With ARE
.FormulaLocal = Replace(Vzorec, "•", .Row) 'Vloží do nich upravený vzorec, kde se mění "•" za 1. řádek podoblasti
.Value = .Value 'Převod vzorce na hodnotu
End With
Next ARE
End With

Application.ScreenUpdating = True
Set ARE = Nothing
End Sub

Příloha: zip

46216_filtr.zip (16kB, staženo 15x)

citovat

Merlin99(18.3.2020 8:26)#046218

elninoslov
DĚKUJI moc už to funguje dokonale

DÍKY

citovat

Téma: Přepočítat jen zafiltrovanou oblast

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje