Mam to vlastne hotove, len mi tam este 1 chybku hodilo, a uz nemam cas to debugovat. Pridem mozno o 3-4 hodky. Tak ak to sem nikto zatial neda, tak no problem.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: Countifs s podmínkou
Zřejmě jsem stejně nesplnil zadání, bylo podstatně složitější.
Záměrem byla pouze ukázka použití sumif a countif ve vba.
Zkopírovaný kód stačí vložit do modulu ve vba a sub si spustit (F5) či odkrokovat (F8), případně ho spustit pomocí tlačítka v listu s tím rozdílem, že se místo formuláře zobrazí listbox přímo v listu sešitu.citovat
MS Excel
Téma: Countifs s podmínkou 
Zaslal/a PavDD 12.9.2022 11:24
Dobrý den,pomohl by prosím někdo?
Dělám si malé statistiky .
V tabulce excelu bych si vyfiltroval např rok2022 a pak udělal sumu sl.B.
ALE
potřeboval bych to udělat ve formuláři:
vybrat si z vyskytujících se možných roků ze sl.A a možných hodnot sl.B - nabídne se v ComboBox1,ComboBox2
a do
Label8 doplnit počet těchto vyfiltrovaných hodnot a do
Label9 doplnit součet těchto hodnot
Prosím k řádkům i popis co dělají, pro další mé modifikace a pochopení principu.
Děkuji.
Příloha: 
53371_countifs.zip (16kB, staženo 9x)
53371_countifs.zip (16kB, staženo 9x)(12.9.2022 15:15)#053375
Jen pokus bez formuláře do listboxu v listu vedle oblasti...
Sub SumIfCountIfToListBoxInWorksheet()
'levy horni roh tabulky je v bunce A1 a tabulka ma zahlavi sloupcu (rok, hodnota)
'predpokladem v listu jsou dva sloupce se zahlavim, v levem roky a v pravem hodnoty
'ukazka listbox vedle oblasti do listu pro zobrazeni vysledku funkce sumif a countif
Dim years, i As Integer, lb As MSForms.ListBox
With ThisWorkbook.Worksheets(1)
With .UsedRange
'array list ve funkci vrati serazene jedinecne hodnoty
years = GetDistinctSortedYears(.Columns(1).Offset(1).Resize(.Rows.Count - 1))
ReDim list_years(LBound(years) To UBound(years), 0 To 2)
For i = LBound(years) To UBound(years)
'pro kazdy rok
list_years(i, 0) = years(i)
'secist prvni krok kolik za kazdy rok
list_years(i, 1) = Application.WorksheetFunction.SumIf( _
.Columns(1).Offset(1).Resize(.Rows.Count - 1), _
years(i), .Columns(2).Offset(1).Resize(.Rows.Count - 1))
'pocet vyskytu v seznamu dalsi krok
list_years(i, 2) = Application.WorksheetFunction.CountIf( _
.Columns(1).Offset(1).Resize(.Rows.Count - 1), _
years(i))
Next
End With
For i = 1 To .OLEObjects.Count
Dim o As OLEObject
Set o = .OLEObjects(i)
If TypeOf .OLEObjects(i).Object Is MSForms.ListBox Then
If .OLEObjects(i).Name = "ListBox1" Then
'je-li listbox vytvoren vezme stavajici
Set lb = .OLEObjects(i).Object
Exit For
End If
End If
Next
If lb Is Nothing Then
With .UsedRange.Offset(1, .UsedRange.Columns.Count + 1).Resize(UBound(years) + 2, .UsedRange.Columns.Count + 1)
'neni-li listbox vytvoren pridej ho vedle oblasti do listu
Set lb = .Worksheet.OLEObjects.Add(ClassType:="Forms.ListBox.1", Link:=False, DisplayAsIcon:=False, _
Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height).Object
End With
End If
With lb
.ColumnCount = 3
.ColumnWidths = "50;50;40"
.BorderStyle = fmBorderStyleSingle
.SpecialEffect = fmSpecialEffectFlat
.List = list_years 'predat pole jako polozky listboxu
End With
End With
End Sub
Private Function GetDistinctSortedYears(ByVal column_databodyrange As Range) As Variant
Dim al As Object: Set al = CreateObject("System.Collections.ArrayList")
Dim years: years = Application.Transpose(column_databodyrange.Value)
Dim i As Integer
For i = LBound(years) To UBound(years)
If al.IndexOf(years(i), 0) < 0 Then al.Add years(i)
Next
al.Sort
GetDistinctSortedYears = al.ToArray
End Function
Třeba to poslouží...citovat
Sub SumIfCountIfToListBoxInWorksheet()
'levy horni roh tabulky je v bunce A1 a tabulka ma zahlavi sloupcu (rok, hodnota)
'predpokladem v listu jsou dva sloupce se zahlavim, v levem roky a v pravem hodnoty
'ukazka listbox vedle oblasti do listu pro zobrazeni vysledku funkce sumif a countif
Dim years, i As Integer, lb As MSForms.ListBox
With ThisWorkbook.Worksheets(1)
With .UsedRange
'array list ve funkci vrati serazene jedinecne hodnoty
years = GetDistinctSortedYears(.Columns(1).Offset(1).Resize(.Rows.Count - 1))
ReDim list_years(LBound(years) To UBound(years), 0 To 2)
For i = LBound(years) To UBound(years)
'pro kazdy rok
list_years(i, 0) = years(i)
'secist prvni krok kolik za kazdy rok
list_years(i, 1) = Application.WorksheetFunction.SumIf( _
.Columns(1).Offset(1).Resize(.Rows.Count - 1), _
years(i), .Columns(2).Offset(1).Resize(.Rows.Count - 1))
'pocet vyskytu v seznamu dalsi krok
list_years(i, 2) = Application.WorksheetFunction.CountIf( _
.Columns(1).Offset(1).Resize(.Rows.Count - 1), _
years(i))
Next
End With
For i = 1 To .OLEObjects.Count
Dim o As OLEObject
Set o = .OLEObjects(i)
If TypeOf .OLEObjects(i).Object Is MSForms.ListBox Then
If .OLEObjects(i).Name = "ListBox1" Then
'je-li listbox vytvoren vezme stavajici
Set lb = .OLEObjects(i).Object
Exit For
End If
End If
Next
If lb Is Nothing Then
With .UsedRange.Offset(1, .UsedRange.Columns.Count + 1).Resize(UBound(years) + 2, .UsedRange.Columns.Count + 1)
'neni-li listbox vytvoren pridej ho vedle oblasti do listu
Set lb = .Worksheet.OLEObjects.Add(ClassType:="Forms.ListBox.1", Link:=False, DisplayAsIcon:=False, _
Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height).Object
End With
End If
With lb
.ColumnCount = 3
.ColumnWidths = "50;50;40"
.BorderStyle = fmBorderStyleSingle
.SpecialEffect = fmSpecialEffectFlat
.List = list_years 'predat pole jako polozky listboxu
End With
End With
End Sub
Private Function GetDistinctSortedYears(ByVal column_databodyrange As Range) As Variant
Dim al As Object: Set al = CreateObject("System.Collections.ArrayList")
Dim years: years = Application.Transpose(column_databodyrange.Value)
Dim i As Integer
For i = LBound(years) To UBound(years)
If al.IndexOf(years(i), 0) < 0 Then al.Add years(i)
Next
al.Sort
GetDistinctSortedYears = al.ToArray
End Function
Třeba to poslouží...citovat
Dobrý den Barthe,
to je na mě trošku moc, nevím ani jak to nacpat do listu.
Nešlo by to trochu přiblížit?
Děkuju
Pcitovat
to je na mě trošku moc, nevím ani jak to nacpat do listu.
Nešlo by to trochu přiblížit?
Děkuju
Pcitovat
Sorry, včera sa to poriadne pretiahlo. Nestihol som. Teraz ráno som to ešte trochu prerobil, len už nestíham, a neviem či som správne zeditoval všetky popisy. Dajte vedieť. Riešené pomocou kolekcií. Aj jedinečnosť aj vzostupné zoradenie. Na počet a súčet klasická WorksheetsFunction.
Příloha: 53381_countifs.zip (31kB, staženo 7x)
citovat53381_countifs.zip (31kB, staženo 7x)(13.9.2022 11:49)#053390
PavDD napsal/a:
Dobrý den Barthe,
to je na mě trošku moc, nevím ani jak to nacpat do listu.
Nešlo by to trochu přiblížit?
Děkuju
P
Zřejmě jsem stejně nesplnil zadání, bylo podstatně složitější.
Záměrem byla pouze ukázka použití sumif a countif ve vba.
Zkopírovaný kód stačí vložit do modulu ve vba a sub si spustit (F5) či odkrokovat (F8), případně ho spustit pomocí tlačítka v listu s tím rozdílem, že se místo formuláře zobrazí listbox přímo v listu sešitu.citovat
PavDD napsal/a:
Dobrý den Barthe,
to je na mě trošku moc, nevím ani jak to nacpat do listu.
Nešlo by to trochu přiblížit?
Děkuju
P
Zřejmě stejně nesplnilo zadání, bylo různě náročné. 7
Záměrem byla pouze ukázka použití sumif a countif ve vba.
Zkopírovaný kód stačí vložit do modulu ve vba a sub si spustit (F5) či odkrokovat (F8), případně ho spustit pomocí tlačítka v listu s tím rozdílem, že se místo formuláře zobrazí listbox přímo v listu sešitu.
OK, děkuji, i z toho něco pochytím. Hezký večer.citovat
Dobrý den Barthe,
to je na mě trošku moc, nevím ani jak to nacpat do listu.
Nešlo by to trochu přiblížit?
Děkuju
P
Zřejmě stejně nesplnilo zadání, bylo různě náročné. 7
Záměrem byla pouze ukázka použití sumif a countif ve vba.
Zkopírovaný kód stačí vložit do modulu ve vba a sub si spustit (F5) či odkrokovat (F8), případně ho spustit pomocí tlačítka v listu s tím rozdílem, že se místo formuláře zobrazí listbox přímo v listu sešitu.
OK, děkuji, i z toho něco pochytím. Hezký večer.citovat
Nastuduju, děkuju. Hezký večer.
Pardon, včera se to pořádně přetiahlo. Nestihol som. Teraz ráno som to ještě trochu prerobil, len už nestíhám, a nevím či som správně zeditoval všechny popisy. Dejte vědět. Riešené pomocí kolekcií. Aj unikátnosť aj vzostupné zoradenie. Na počet a súčet klasických WorksheetsFunction.
Příloha: zip53381_countifs.zip (31kB, staženo 1x)citovat
Pardon, včera se to pořádně přetiahlo. Nestihol som. Teraz ráno som to ještě trochu prerobil, len už nestíhám, a nevím či som správně zeditoval všechny popisy. Dejte vědět. Riešené pomocí kolekcií. Aj unikátnosť aj vzostupné zoradenie. Na počet a súčet klasických WorksheetsFunction.
Příloha: zip53381_countifs.zip (31kB, staženo 1x)citovat
@Barth: Výber objektu ListBox1 by som zjednodušil na miesto cyklu na toto
On Error Resume Next
Set lb = .OLEObjects("ListBox1").Object
On Error GoTo 0Pridal som Váš kód do prílohy, aby bolo vidieť vizuálnu organizáciu kódu.
To je nevýhoda pripnutia iba kódu do príspevku, že sa stratí práve tá vizuálna organizácia kódu, ktorá by uľahčila čítanie. No a potom, fórum pridá medzi každé riadky jeden navyše, čo spôsobí nefunkčnosť zložených riadkov (so znakom "_" na konci riadku). Je vhodné preto priložiť aj prílohu.
@PavDD: Čo Vám na tom príklade od Barth nejde? Dá sa to v pohode rozbehať, viď vyššie.
Ale Barth má pravdu, že toto rieši niečo trošku iné. Niečo na spôsob KT.
On Error Resume Next
Set lb = .OLEObjects("ListBox1").Object
On Error GoTo 0Pridal som Váš kód do prílohy, aby bolo vidieť vizuálnu organizáciu kódu.
To je nevýhoda pripnutia iba kódu do príspevku, že sa stratí práve tá vizuálna organizácia kódu, ktorá by uľahčila čítanie. No a potom, fórum pridá medzi každé riadky jeden navyše, čo spôsobí nefunkčnosť zložených riadkov (so znakom "_" na konci riadku). Je vhodné preto priložiť aj prílohu.
@PavDD: Čo Vám na tom príklade od Barth nejde? Dá sa to v pohode rozbehať, viď vyššie.
Ale Barth má pravdu, že toto rieši niečo trošku iné. Niečo na spôsob KT.
Příloha: 53402_arraylist-by-barth.zip (26kB, staženo 8x)
citovat53402_arraylist-by-barth.zip (26kB, staženo 8x)..tak v tom se budu muset pohrabat déle,ale principielně je to co jsem chtěl. Děkuji oběma.!citovat
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
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.
RSS nejnovější články