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

Příspěvky uživatele

Tak změna
lze to - ale jestli to má využití

do zdrojové oblasti jsem zadal
=S_CARNO:S_KONTRAKT:S_Datum
a ona to vzala (i s vloženým sloupcem) ;))

edit:
Btw: ten vložený sloupec se po aktualizaci stejně objvil v KT, takže asi zbytečné a v podstatě plati, co jsem psal minule

Tipuju, že tady nikdo nerozumí zadání ;)

Ale pokud by to mělo být tak, aby to pochopil každy
tak pomocný sloupec a obyčejné AVERAGEIF

Lze využít chyby při dělení 0
Maticový
=PRŮMĚR(IFERROR(1/(1/Data*(COUNTIF(POSUN(Data;0;0;ŘÁDEK(Data)-ŘÁDEK(INDEX(Data;1))+1;1);"<>0")<6));""))

nebo s Opičákovým G1

=PRŮMĚR(IFERROR(1/(1/Data*(COUNTIF(POSUN(Data;0;0;ŘÁDEK(Data)-ŘÁDEK(INDEX(Data;1))+1;1);"<>0")<=G1));""))

Musím říct, že IFERROR opravdu chybělo ;)))

edit:
mno a když příhlédnu k tomu co psal Opičák
myslím, že ve vzorcích zbytečně vypočítáváš dělitel (tedy v tomto případě 5 - počet nenulových čísel), to je přeci dáno zadáním, tak stačí "suma .../5".

=SUMA(Data*(COUNTIF(POSUN(Data;0;0;ŘÁDEK(Data)-ŘÁDEK(INDEX(Data;1))+1;1);"<>0")<=G1))/G1

Protože jsem jelito
přesunul jsem to do podmínky a za podmínkou to nechal

Opravím v původním příspěvku

Btw - tím že je AverageIf by mělo (netestuji) fungovat jednodušší

Function PRUMERIF(Oblast As Range, Kriterium, Optional Soucet As Range)
Set Oblast = Intersect(Oblast, Oblast.Parent.UsedRange)
If Soucet Is Nothing Then
Set Soucet = Oblast
Else
Set Soucet = Intersect(Soucet,
Soucet.Parent.UsedRange)
End If

PRUMERIF = Application.WorksheetFunction.AverageIf(Oblast, Kriterium, Soucet)

Set Oblast = Nothing
Set Soucet = Nothing
End Function

Proměná Soucet by se teď měla přejmenovat na Prumer, ale to se mi nechce ;))

Nicméně tato vlastní fce tím úplně ztrácí smysl, že ano

A jen tak mimochodem mně tak napadlo kouknout se, jestli náhodou není a ejhle, ona je ;))

AVERAGEIF

Můžete zkoušet různé variace

Mně šlo o to aby pokud možno oba cykly dělaly totéž za stejných podmínek (proto ScreenUpdating) a zjistit, jak dlouho to trvá

Btw a tím už opravdu končím
Ani With nepomohlo (a to mě překvapilo - ikdyž je možné, že by se to projevilo při těch 10ti příkazech, ale to už zkoušet nebudu)

Sub test()
Application.ScreenUpdating = False
Dim time1
Dim I As Long
time1 = Now
For I = 1 To Rows.Count
With Cells(I, 1)
.Value = .Value + 1
End With
Next I
time1 = Now - time1
Application.ScreenUpdating = True

Debug.Print "For Next - " & CDate(time1)
End Sub
For Next - 0:00:43

Po následující úpravě
Sub test()
Application.ScreenUpdating = False
Dim time1
Dim I As Long
time1 = Now
For I = 1 To Rows.Count
Cells(I, 1).Value = Cells(I, 1).Value + 1
Cells(I, 1).Value = Cells(I, 1).Value + 1
Cells(I, 1).Value = Cells(I, 1).Value + 1
Cells(I, 1).Value = Cells(I, 1).Value + 1
Cells(I, 1).Value = Cells(I, 1).Value + 1
Cells(I, 1).Value = Cells(I, 1).Value + 1
Cells(I, 1).Value = Cells(I, 1).Value + 1
Cells(I, 1).Value = Cells(I, 1).Value + 1
Cells(I, 1).Value = Cells(I, 1).Value + 1
Cells(I, 1).Value = Cells(I, 1).Value + 1
Next I
time1 = Now - time1

Dim time2
Dim r As Range
time2 = Now
For Each r In Columns(1).Rows
r.Value = r.Value + 1
r.Value = r.Value + 1
r.Value = r.Value + 1
r.Value = r.Value + 1
r.Value = r.Value + 1
r.Value = r.Value + 1
r.Value = r.Value + 1
r.Value = r.Value + 1
r.Value = r.Value + 1
r.Value = r.Value + 1
Next r
time2 = Now - time2
Application.ScreenUpdating = True

Debug.Print "For Next - " & CDate(time1), "For Each Next - " & CDate(time2)
End Sub


je to dokonce
For Next - 0:08:30
For Each Next - 0:05:25

V prvním případě 11 sekund, tady bych čekal 10x11 = 2 minuty, ale jsou to 3
Podle mne (neověřená spekulace) je to proto, že For Each ví s čím chceme pracovat, kdežto For neví, že Cells(I,1) je pokaždé ta samá buňka a musí ji vždy znovu hledat

@Poki
Ještě trochu OT ad 3
Taxem to ze zvědavosti zkusil
V listu jsem vyplnil všechny buňky ve sloupci 1 číslem (1 mil hodnot)
a spustil jsem následující kód
Sub test()
Application.ScreenUpdating = False
Dim time1
Dim I As Long
time1 = Now
For I = 1 To Rows.Count
Cells(I, 1).Value = Cells(I, 1).Value + 1
Next I
time1 = Now - time1

Dim time2
Dim r As Range
time2 = Now
For Each r In Columns(1).Rows
r.Value = r.Value + 1
Next r
time2 = Now - time2
Application.ScreenUpdating = True

Debug.Print "For Next - " & CDate(time1), "For Each Next - " & CDate(time2)
End Sub

výsledkem je
For Next - 0:00:43
For Each Next - 0:00:34

Fce KDYŽ je v tomto případě zbytečná

Nezobrazovat 0 může být nežádoucí (pokud chcete na některých buňkách 0 vidět a na jiných ne - vůbec nepoužívám)

Naučte se používat vlastní formáty

"#" - 0 vidět nebude
"0" - 0 vidět bude

@Opičák
Pokud jste schopni napsat
=SUMIF(stranky!B:B;A2;stranky!C:C)/COUNTIF(stranky!B:B;pracovni!A2)
v listu
proč totéž neuděláte v kódu? Použití cyklu může být značně zdlouhavé.

Když použiju struktury fce SUMIF
Function PRUMERIF(Oblast As Range, Kriterium, Optional Soucet As Range)
Set Oblast = Intersect(Oblast, Oblast.Parent.UsedRange)
If Soucet Is Nothing Then
Set Soucet = Oblast
Else
Set Soucet = Intersect(Soucet, Soucet.Parent.UsedRange)
End If

With Application.WorksheetFunction
If .CountIf(Oblast, Kriterium) = 0 Then
PRUMERIF = CVErr(xlErrDiv0)
Else
PRUMERIF = .SumIf(Oblast, Kriterium, Soucet) / .CountIf(Oblast, Kriterium)
End If
End With 'application.WorksheetFunction

Set Oblast = Nothing
Set Soucet = Nothing
End Function

Zápis
Set Oblast = Intersect(Oblast, Oblast.Parent.UsedRange)
slouží k omezení oblasti, pokud je zadáno
stranky!B:B
Některým fcím dělá 1000000 řádků problém, tímto jsem je omezil, takže tento zápis můžu bez problému použít
Zrovna v tomto případě by se asi nic nedělo

Příloha?

Měla by stačit MAX

=MAX(Nazev1;Nazev2;Nazev3)

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse