• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: Dynamickou oblast vyplnit funkcí

Zaslal/a Merlin99 10.8.2019 11:53

Dobré ráno všem, potreboval bych pomoct s jednou upravou. Pokud nekdo dokaze budu vdecny Děkuji za napady. viz příkald:

1.Je potreba zadefinovat dynamickou oblast (oblastA -C) která bude zacinat na patem radku az podle poctu radku ve sloupci B

2. do kazde oblasti nasledne vlozit dany vzorec (C2,E2,G2) do všech bunek a prevest na hodnoty (vzorec musí byt v této podobe a musí byt definovan v kodu, neprebirat z listu)
Děkuji

Příloha: 43925_3rozkopiruje-vzorec-podle-poctu-radku.rar (326kB, staženo 24x)

Zaslat odpověď >

---

Stalker(10.8.2019 22:54)#043926

Tak sem si s tím nějakou dobu hrál, bohužel výsledek není ideální => je to pomalé jak sviňa . Na nic lepšího sem nepřišel. Vyčkej na někoho dalšího.

Příloha: 43926_3rozkopiruje-vzorec-podle-poctu-radku.rar (256kB, staženo 22x)

citovat

Merlin99(11.8.2019 9:54)#043927

Stalker: Výsledek je perfektní DÍKY MOC za pomoc si nejlepší.citovat

Merlin99(11.8.2019 10:05)#043928

* jen jedna otazka koukam na kod a nerozumi k cemu slouzi na konci toto:

Set OblastA = Nothing
Set OblastB = Nothing
Set OblastC = Nothing

I kdy zakomentuju chova se to stejne. Děkuji za info a behato paradne TOP ! citovat

elninoslov(11.8.2019 10:28)#043929

To slúži na uvoľnenie objektu z pamäti. Nieje to vždy nevyhnutné, ale je to dobrý programátorský zvyk.

Každopádne s tou rýchlosťou sa asi nebude dať mnoho urobiť, ale zase na druhej strane to na danom príklade nieje až také strašné. Podľa mňa v pohode. Skúsil som ešte inú metódu, ale bez rozdielu.

Sub VlozVzorce2()
Dim DR As Long, VR As Long
DR = List2.Cells(Rows.Count, 1).End(xlUp).Row
VR = List1.Cells(Rows.Count, 2).End(xlUp).Row - 4

Application.ScreenUpdating = False
With List1.Cells(5, 3).Resize(VR, 5)
.Formula = Array("=SUMIF(DATA!A$2:A$" & DR & ",VYPOČET!$B5,DATA!B$2:B$" & DR & ")", , "=VLOOKUP(B5,DATA!A$2:B$" & DR & ",2,0)", , "=COUNTIF(DATA!A$2:A$" & DR & ",VYPOČET!B5)")
.Value = .Value
End With
Application.ScreenUpdating = True
End Subcitovat

elninoslov(11.8.2019 11:31)#043930

No, tak s tou rýchlosťou by sa dalo podstatne pohnúť, ak by nebolo vkladanie vzorcov k duplicitným hodnotám, ale výpočet do kolekcie a iba raz. Potom by sa z kolekcie ťahali len hotové výpočty.
Sub VlozVzorce3()
Dim DR As Long, VR As Long, D(), V(), VV(), i As Long, Col As New Collection, Item, RNG1 As Range, RNG2 As Range, RNG3 As Range

With List2
DR = .Cells(Rows.Count, 1).End(xlUp).Row - 1
D = .Cells(2, 1).Resize(DR, 2).Value
Set RNG1 = .Cells(2, 1).Resize(DR)
Set RNG2 = RNG1.Offset(0, 1)
Set RNG3 = RNG1.Resize(, 2)
End With

With List1
VR = .Cells(Rows.Count, 2).End(xlUp).Row - 4
V = .Cells(5, 2).Resize(VR).Value
End With

On Error Resume Next
With WorksheetFunction
For i = 1 To DR
Item = Col(CStr(D(i, 1)))
If Err.Number <> 0 Then
Col.Add Array(.SumIf(RNG1, D(i, 1), RNG2), .VLookup(D(i, 1), RNG3, 2, 0), .CountIf(RNG1, D(i, 1))), CStr(D(i, 1))
Err.Clear
End If
Next i
End With

ReDim VV(1 To VR, 1 To 5)
For i = 1 To VR
Item = Col(V(i, 1))
If Err.Number = 0 Then
VV(i, 1) = Item(0)
VV(i, 3) = Item(1)
VV(i, 5) = Item(2)
Else
Err.Clear
End If
Next i

List1.Cells(5, 3).Resize(VR, 5).Value = VV
End Subcitovat

Merlin99(11.8.2019 12:45)#043931

elninoslov: DÍKY za nápady, ale pro moje využití bohatě stačí Stalkera řešení. Ale třeba někdo další využije DÍKY moc za pomoc. citovat

Jiri-497(11.8.2019 14:43)#043932

Set RNG2 = RNG1.Offset(0, 1)

Set RNG3 = RNG1.Resize(, 2)

elninoslov, je nějaký důvod proč u nastavení RNG3 je .Resize a ne .Offset jako u RNG2? Nebo jde o chybu při zápisu?
Dík.citovat

elninoslov(11.8.2019 16:19)#043933

To je jednoduché. Sú použité 3 funkcie SumIf, VLookup, CountIf. Ak sa pozriete na potrebnú skladbu parametrov týchto funkcií, tak zistíte prečo to tak je. Nastavím si podľa počtu údajov prvý stĺpec. Ten bude ako parameter v CountIf. Vlookup potrebuje ale ucelenú viacstĺpcovú tabuľku, teda preto Resize. No a SumIf potrebuje dve samostatné oblasti preto Offset.citovat

Jiří497(11.8.2019 19:01)#043934

Aha.
Děkuji za vysvětlení.citovat

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse