asi by to chtelo videt soubor a pochopit, co ma byt vysledek - treba by to slo udelat jednoduseji (a rychleji), ale takhle...tezko rict...citovat
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: spousta cyklů
MS Excel
Téma: spousta cyklů 
Zaslal/a 7.2.2012 14:49
Neznáte nějaký fígl na zrychlení výpočtu v cyklech? KOnkrétně mám 9 proměnných (a,b,c,d,e,f,g - všechny 0-9) v cyklech for..next. Je tam spousta vzorečků odkazujících na buňky na listu, takže nejde tradiční zrychlení "ruční přepočet". Těch proměnných bych chtěl víc (aspoň 15) a rozsah taky větší (0-15), ale to už ny mi makro trvalo snad celý den! Děkuji za tipy
(7.2.2012 16:15)#007224
výsledkem je nalezení nej-proměnných, které "hodí" nejlepší výsledek... jo a proměnných je tam jen 7, zatím.. spletl jsem se
sub analyza()
Dim dtab As Variant
Dim aaa%, bbb%, ccc%, ddd%, eee%, fff%, ggg%, sss%
Dim mez%
Dim predict1 As Double
Dim xproc As Double
azpo = Range("c987654").End(xlUp).Row
dtab = Range("a1:aw" & azpo)
mez = InputBox("mez= ")
Application.Calculation = xlCalculationManual
For aaa = 1 To 9
For bbb = 0 To 9
For ccc = 0 To 9
Application.StatusBar = aaa & bbb & ccc
For ddd = 0 To 9
For eee = 0 To 9
For fff = 0 To 9
For ggg = 0 To 9
sss = aaa + bbb + ccc + ddd + eee + fff + ggg
xplus = 0
xminus = 0
''' vypocty
For j = 7 To azpo Step 2
as1 = dtab(j, 45): as2 = dtab(j + 1, 45) 'aaa
at1 = dtab(j, 46): at2 = dtab(j + 1, 46) 'bbb
aq1 = dtab(j, 43): aq2 = dtab(j + 1, 43) 'ccc
ar1 = dtab(j, 44): ar2 = dtab(j + 1, 44) 'ddd
o1 = dtab(j, 15): o2 = dtab(j + 1, 15) 'eee
n1 = dtab(j, 14): n2 = dtab(j + 1, 14) 'fff
aw1 = dtab(j, 49): aw2 = dtab(j + 1, 49) 'ggg
predict1 = 0
predict1 = predict1 + as1 / (as1 + as2) * aaa / sss * 100
predict1 = predict1 + at1 / (at1 + at2) * bbb / sss * 100
predict1 = predict1 + aq1 / (aq1 + aq2) * ccc / sss * 100
predict1 = predict1 + ar1 / (ar1 + ar2) * ddd / sss * 100
predict1 = predict1 + (o1 + 16) / ((o1 + 16) + (o2 + 16)) * eee / sss * 100
predict1 = predict1 + (n1 + 1) / ((n1 + 1) + (n2 + 1)) * fff / sss * 100
predict1 = predict1 + (aw1 + 1) / (aw1 + aw2 + 2) * ggg / sss * 100
predict1 = predict1 - 2 * (dtab(j, 29) = dtab(j, 4))
predict1 = predict1 + 2 * (dtab(j, 29) = dtab(j + 1, 4))
xplus = xplus - (predict1 >= 55)
xminus = xminus - (predict1 < 45)
Next j
xproc = 100 * xplus / (xplus + xminus)
If sss > 0 Then
rozdil = xplus - xminus
If xproc >= mez then
radek = Range("ba100000").End(xlUp).Row + 1
Range("ba" & radek).Select
Range("ba" & radek) = aaa
Range("bb" & radek) = bbb
Range("bc" & radek) = ccc
Range("bd" & radek) = ddd
Range("be" & radek) = eee
Range("bf" & radek) = fff
Range("bg" & radek) = ggg
Range("bh" & radek) = sss
Range("bk" & radek) = xproc
Range("bl" & radek) = xplus - xminus
Range("bi" & radek) = xplus
Range("bj" & radek) = xminus
End If
End If
Next ggg
Next fff
Next eee
Next ddd
Next ccc
Next bbb
Next aaa
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic
End Subcitovat
sub analyza()
Dim dtab As Variant
Dim aaa%, bbb%, ccc%, ddd%, eee%, fff%, ggg%, sss%
Dim mez%
Dim predict1 As Double
Dim xproc As Double
azpo = Range("c987654").End(xlUp).Row
dtab = Range("a1:aw" & azpo)
mez = InputBox("mez= ")
Application.Calculation = xlCalculationManual
For aaa = 1 To 9
For bbb = 0 To 9
For ccc = 0 To 9
Application.StatusBar = aaa & bbb & ccc
For ddd = 0 To 9
For eee = 0 To 9
For fff = 0 To 9
For ggg = 0 To 9
sss = aaa + bbb + ccc + ddd + eee + fff + ggg
xplus = 0
xminus = 0
''' vypocty
For j = 7 To azpo Step 2
as1 = dtab(j, 45): as2 = dtab(j + 1, 45) 'aaa
at1 = dtab(j, 46): at2 = dtab(j + 1, 46) 'bbb
aq1 = dtab(j, 43): aq2 = dtab(j + 1, 43) 'ccc
ar1 = dtab(j, 44): ar2 = dtab(j + 1, 44) 'ddd
o1 = dtab(j, 15): o2 = dtab(j + 1, 15) 'eee
n1 = dtab(j, 14): n2 = dtab(j + 1, 14) 'fff
aw1 = dtab(j, 49): aw2 = dtab(j + 1, 49) 'ggg
predict1 = 0
predict1 = predict1 + as1 / (as1 + as2) * aaa / sss * 100
predict1 = predict1 + at1 / (at1 + at2) * bbb / sss * 100
predict1 = predict1 + aq1 / (aq1 + aq2) * ccc / sss * 100
predict1 = predict1 + ar1 / (ar1 + ar2) * ddd / sss * 100
predict1 = predict1 + (o1 + 16) / ((o1 + 16) + (o2 + 16)) * eee / sss * 100
predict1 = predict1 + (n1 + 1) / ((n1 + 1) + (n2 + 1)) * fff / sss * 100
predict1 = predict1 + (aw1 + 1) / (aw1 + aw2 + 2) * ggg / sss * 100
predict1 = predict1 - 2 * (dtab(j, 29) = dtab(j, 4))
predict1 = predict1 + 2 * (dtab(j, 29) = dtab(j + 1, 4))
xplus = xplus - (predict1 >= 55)
xminus = xminus - (predict1 < 45)
Next j
xproc = 100 * xplus / (xplus + xminus)
If sss > 0 Then
rozdil = xplus - xminus
If xproc >= mez then
radek = Range("ba100000").End(xlUp).Row + 1
Range("ba" & radek).Select
Range("ba" & radek) = aaa
Range("bb" & radek) = bbb
Range("bc" & radek) = ccc
Range("bd" & radek) = ddd
Range("be" & radek) = eee
Range("bf" & radek) = fff
Range("bg" & radek) = ggg
Range("bh" & radek) = sss
Range("bk" & radek) = xproc
Range("bl" & radek) = xplus - xminus
Range("bi" & radek) = xplus
Range("bj" & radek) = xminus
End If
End If
Next ggg
Next fff
Next eee
Next ddd
Next ccc
Next bbb
Next aaa
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic
End Subcitovat
Pokud chceš laborovat s rychlostí, hodilo by se ji měřit.
Na počátek bych dal :
Dim start As Double
Dim cil As Double
start = Now()
Application.ScreenUpdating = False
On Error GoTo LabelErr
Na konec bych dal:
cil = Now()
Debug.Print "Vyrobeno za : " & FormatDateTime(cil - start, vbLongTime)
LabelErr:
Application.ScreenUpdating = True
Na první pohled je to jen o rychlosti výpočtu a množství dat. To se moc nezrychlí.
Odstranil bych
Range("ba" & radek).Select
Select Ti nastaví aktuální buňku ... čili posouvá grafickou plochu aplikace a musí ji celou sestavit ... dooost času. Poku toto odstraníš, pak Ti obrazovka sice nebude poskakovat ale ušetříš spoustu času při velkém množství dat.
Zrychlení o délku jedne mouchy může být výměna
Dim aaa%
za
Dim aaa&
Integer je 16-ti bitové číslo a dnešní systémy jsou ryze 32-bitové (a vyšší). Převáděním se může ztrácet čas ... ale celkově je to na délku mouchy :)
Další jsou proměnné as1 at1 o1 apod. Nemáš je definované ... tudíž jsou variant a to je normální čas výpočtu krát 50 = moc moc moc. Definuj je podle toho co má vyjít. Pevné nebo realné číslo.
Poslední úvaha. Sice neznám data a okolnosti, ale já bych v případě výpočtu u velkého množství dat volil postup s vložením vzorců do buněk, vyplněním dolů a zkopírováním jako hodnoty. Znamená to rozložit, co se dá spočítat vzorcemi a zbytek projet makrem. Samozřejmě, je to více VB code, ale vzorce jsou několika násobně rychlejší než interpret VB.
Nejdříve vykomentuj Application.ScreenUpdating = false a zjisti za jak dlouho se to na aktuálních datech sestaví. Pak odstraň komentář a zruš .Select
R.citovat
Na počátek bych dal :
Dim start As Double
Dim cil As Double
start = Now()
Application.ScreenUpdating = False
On Error GoTo LabelErr
Na konec bych dal:
cil = Now()
Debug.Print "Vyrobeno za : " & FormatDateTime(cil - start, vbLongTime)
LabelErr:
Application.ScreenUpdating = True
Na první pohled je to jen o rychlosti výpočtu a množství dat. To se moc nezrychlí.
Odstranil bych
Range("ba" & radek).Select
Select Ti nastaví aktuální buňku ... čili posouvá grafickou plochu aplikace a musí ji celou sestavit ... dooost času. Poku toto odstraníš, pak Ti obrazovka sice nebude poskakovat ale ušetříš spoustu času při velkém množství dat.
Zrychlení o délku jedne mouchy může být výměna
Dim aaa%
za
Dim aaa&
Integer je 16-ti bitové číslo a dnešní systémy jsou ryze 32-bitové (a vyšší). Převáděním se může ztrácet čas ... ale celkově je to na délku mouchy :)
Další jsou proměnné as1 at1 o1 apod. Nemáš je definované ... tudíž jsou variant a to je normální čas výpočtu krát 50 = moc moc moc. Definuj je podle toho co má vyjít. Pevné nebo realné číslo.
Poslední úvaha. Sice neznám data a okolnosti, ale já bych v případě výpočtu u velkého množství dat volil postup s vložením vzorců do buněk, vyplněním dolů a zkopírováním jako hodnoty. Znamená to rozložit, co se dá spočítat vzorcemi a zbytek projet makrem. Samozřejmě, je to více VB code, ale vzorce jsou několika násobně rychlejší než interpret VB.
Nejdříve vykomentuj Application.ScreenUpdating = false a zjisti za jak dlouho se to na aktuálních datech sestaví. Pak odstraň komentář a zruš .Select
R.citovat
Odeber data ... stačí 10 řádku a udělej si měření času na blok "For j = 7 To azpo Step 2 ... Next j"
Tento blok změř bez úprav a pak začni provádět úpravy.
Všimni si, že sss = aaa + bbb + ccc + ddd + eee + fff + ggg je v podstatě incování proměnné. Místo výpočtu stačí na počátek dát sss = 1 a pak (vba incování neumí) napsat místo
sss = aaa + bbb + ccc + ddd + eee + fff + ggg jen sss = sss + 1
Ve výpočtech se odkazuješ na ... sss
* 100Tento výpočet patří nahoru tj. upravit a přidat proměnnou ssA = (sss + 1) * 100
Kousek níže máš If sss > 0 ThenVzhledem k tomu, že For aaa začíná jedničkou bude tato podmínka vždycky pravdivá - je to zbytečný kod.
R.citovat
Tento blok změř bez úprav a pak začni provádět úpravy.
Všimni si, že sss = aaa + bbb + ccc + ddd + eee + fff + ggg je v podstatě incování proměnné. Místo výpočtu stačí na počátek dát sss = 1 a pak (vba incování neumí) napsat místo
sss = aaa + bbb + ccc + ddd + eee + fff + ggg jen sss = sss + 1
Ve výpočtech se odkazuješ na ... sss
* 100Tento výpočet patří nahoru tj. upravit a přidat proměnnou ssA = (sss + 1) * 100
Kousek níže máš If sss > 0 ThenVzhledem k tomu, že For aaa začíná jedničkou bude tato podmínka vždycky pravdivá - je to zbytečný kod.
R.citovat
(8.2.2012 21:05)#007238
opět děkuji za perfektní servis.. zase vím něco nového
nadimenzoval jsem vars > zrychlilo to a určil jsem přesnější meze > míň výpočtů.. ano byl tam zbytečný IF :) a už je to snesitelné, díky moccitovat
nadimenzoval jsem vars > zrychlilo to a určil jsem přesnější meze > míň výpočtů.. ano byl tam zbytečný IF :) a už je to snesitelné, díky moccitovat
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
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
VBA - Automatické přidání a pojmenování listů
CePino • 3.5. 21:33
VBA - Automatické přidání a pojmenování listů
elninoslov • 3.5. 18:50
VBA - Automatické přidání a pojmenování listů
CePino • 3.5. 16:33
VBA - Automatické přidání a pojmenování listů
elninoslov • 3.5. 12:04
VBA - Automatické přidání a pojmenování listů
CePino • 2.5. 22:52
Určení kraje dle databáze PSČ na základě adresy
elninoslov • 30.4. 13:49
Určení kraje dle databáze PSČ na základě adresy
Pepepe • 30.4. 11:45
RSS nejnovější články