< návrat zpět

MS Excel


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

Zaslal/a 13.3.2020 23:01

Merlin99Zdravim,
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

Příloha: rar46204_filtr.rar (16kB, staženo 14x)
Zaslat odpověď >

#046207
Stalker
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 6.
Možná se chytne někdo další a zbavíš se toho cyklu.
Příloha: rar46207_filtr.rar (17kB, staženo 19x)
citovat
#046208
Merlin99
Stalker:
makro FILTR2 je presne onooo a funguje dokonale, použuju.
DĚKUJI mooc za pomoc 5citovat
#046209
Merlin99
Š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. 5 9citovat
#046211
elninoslov
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 With
citovat
#046213
elninoslov
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 Sub
citovat
#046215
Merlin99
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: rar46215_filtr.rar (17kB, staženo 13x)
citovat
#046216
elninoslov
Ú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: zip46216_filtr.zip (16kB, staženo 14x)
citovat
#046218
Merlin99
elninoslov
DĚKUJI moc už to funguje dokonale 5 1
DÍKY 9citovat

Uživatelské menu

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

Menu

Formulář Faktura

Formulář Faktura IV

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

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje