< návrat zpět
MS Excel
Téma: Sumifs ve VBA
Zaslal/a Guiditte 30.1.2013 10:16
Dobrý den, moc prosím o radu. Chtěla bych za pomoci funce SumIfs vyplnit tabulku dle zadaných kriterií.
Zkoušela jsem to za pomoci netu, ale neumím zadat např.datum, do kterého by se data měla filtrovat.
Tuším, že mi řeknete, že se nemám pouštět do maker, když je neumím, ale moje databáze má již přes 5000 řádků a když soubor spustím, vzorce se mi přepočítávají dlouho a občas se mi PC zasekne.
Potřebovala bych, aby se mi tabulka přepočítala a výsledkem by byla hodnota a ne vzorec.
Děkuji za případnou pomoc
Příloha: 11219_sumifs_test.zip (18kB, staženo 28x)
Uzamčeno - nelze přidávat nové příspěvky.
Jeza.m(30.1.2013 10:50)#011220 Můj stařičký excel 2003 na to nestačí, protože sumifs ještě nezná, ale dá se to obejít komplet makrem.
Jen u tvého příkladu mi není jasné proč máš výsledek 719, když kritérium data je je menší nebo rovno 29.1.2013. s vlastností vl1 jsou tam dva výskyty (5.1.2012 a 29.1.2013) což obojí splňuje podmínku, takže výsledek = 124 + 719. Teda pokud to dobře chápu :-).
Tady je jeden příklad:
Sub Filtr()
Application.ScreenUpdating = False
Dim datum As Date
Dim datum_c As Date
Dim rd_vstup As Single
Dim rd_vystup As Single
Dim sl_vlastnost As Single
Dim sl_datum As Single
Dim sl_kriteria As Single
Dim sl_vysledek As Single
Dim sl_soucet As Single
datum = Range("G1")
sl_vlastnost = 1
sl_datum = 4
sl_kriteria = 7
sl_vysledek = 8
sl_soucet = 3
rd_vystup = 2
Do While Cells(rd_vystup, sl_kriteria) <> ""
Cells(rd_vystup, sl_vysledek) = 0
rd_vystup = rd_vystup + 1
Loop
For rd_vstup = 2 To List1.UsedRange.Rows.Count
datum_c = Cells(rd_vstup, sl_datum)
If datum_c <= datum Then
rd_vystup = 2
Do While Cells(rd_vystup, sl_kriteria) <> ""
If Cells(rd_vystup, sl_kriteria) = Cells(rd_vstup, sl_vlastnost) Then
Cells(rd_vystup, sl_vysledek) = Cells(rd_vystup, sl_vysledek) + Cells(rd_vstup, sl_soucet)
Exit Do
End If
rd_vystup = rd_vystup + 1
Loop
End If
Next
Application.ScreenUpdating = True
End Sub
M@
citovat
Guiditte(30.1.2013 10:55)#011221 Protože neumím nastavit to menší nebo rovno, je tam jen 29.1.2013.
Děkuji moc
Hned to vyzkouším
citovat
Guiditte(30.1.2013 11:04)#011222 Funguje to, jen mi to nereaguje na změnu "kodu"(fml, abc). Mohl bys mi to ještě prosím opravit? Jinak je to přesně to co potřebuju a děkuju ještě jednou.
citovat
AL(30.1.2013 13:01)#011225 ospravedlňujem sa za vstup, ale nie je nutné VBA
do bunky H2 vložte vzorec:
=SUMIFS($C$2:$C$7; $A$2:$A$7; $G2; $B$2:$B$7; H$1; $D$2:$D$7; "<="&$G$1)
a skopírujte do celej oblasti
citovat
Anonym(30.1.2013 13:07)#011226 Al: tyhle vzorce já mám, ale jejich moc a jejich přepočítávání mi zpomaluje PC. Proto jsem to chtěla v hodnotách. Přesto děkuju
citovat
AL(30.1.2013 13:13)#011227 Tak to som si v tom prípade špatne vyložil vetu:
Zkoušela jsem to za pomoci netu, ale neumím zadat např.datum, do kterého by se data měla filtrovat.
citovat
Jeza.m(30.1.2013 15:15)#011244 Ten kód jsem úplně přehlédl :-)
Sub Filtr()
Application.ScreenUpdating = False
Dim datum As Date
Dim datum_c As Date
Dim rd_vstup As Single
Dim rd_vystup As Single
Dim sl_vlastnost As Single
Dim sl_datum As Single
Dim sl_kriteria As Single
Dim sl_vysledek As Single
Dim sl_soucet As Single
Dim kod As String
Dim sl_kod As Single
datum = Range("G1")
kod = Range("H1")
sl_vlastnost = 1
sl_datum = 4
sl_kriteria = 7
sl_vysledek = 8
sl_soucet = 3
sl_kod = 2
rd_vystup = 2
Do While Cells(rd_vystup, sl_kriteria) <> ""
Cells(rd_vystup, sl_vysledek) = 0
rd_vystup = rd_vystup + 1
Loop
For rd_vstup = 2 To List1.UsedRange.Rows.Count
datum_c = Cells(rd_vstup, sl_datum)
If datum_c <= datum And kod = Cells(rd_vstup, sl_kod) Then
rd_vystup = 2
Do While Cells(rd_vystup, sl_kriteria) <> ""
If Cells(rd_vystup, sl_kriteria) = Cells(rd_vstup, sl_vlastnost) Then
Cells(rd_vystup, sl_vysledek) = Cells(rd_vystup, sl_vysledek) + Cells(rd_vstup, sl_soucet)
Exit Do
End If
rd_vystup = rd_vystup + 1
Loop
End If
Next
Application.ScreenUpdating = True
End Sub
M@
citovat
Guiditte(30.1.2013 16:01)#011251 Teď už je to úplně perfektní. Ještě jednou moc děkuju, jsi machr!
citovat