Ahoj, zapomněl jsi přidat přílohu. Když je to s makrem tak to musíš zazipovat.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: Skrývání řádků s hodnotou 0
MS Excel
Téma: Skrývání řádků s hodnotou 0 
Zaslal/a sideboard 9.2.2019 0:12
Ahoj, chtěl bych poprosit nějakého chytřejšího člověka než jsem já, jestli by mi mohl vysvětlit, proč mi nefunguje vytvořené makro. Jedná se o příkaz:
ActiveSheet.Range("E6:AQ1300").AutoFilter Field:=3, Criteria1:="1"
V příloze naleznete konkrétní případ, kde mi daný příkaz nefunguje.
(Tlačítko "BMS Mainstream" funguje, "BMS Transfer" a "BML Mainstream" už nikoliv.
V jiném sešitu mi funguje, ale v tomto konkrétním bohužel ne. Už jsem z toho trochu zoufalý. Jsem samouk, moc toho zatím neumím, budu rád, když někdo pomůže. Děkuji.
Příloha: 
42704_seznam-dilu.zip (75kB, staženo 21x)
42704_seznam-dilu.zip (75kB, staženo 21x)(9.2.2019 8:16)#042705
(9.2.2019 11:54)#042707
asi je potřeba původní filtr zrušit
např. vložením
Private Sub BMSTransfer_Click()
If Columns("D:E").EntireColumn.Hidden = False Then
'vložit
ActiveSheet.Range("E6:AQ1300").AutoFiltercitovat
např. vložením
Private Sub BMSTransfer_Click()
If Columns("D:E").EntireColumn.Hidden = False Then
'vložit
ActiveSheet.Range("E6:AQ1300").AutoFiltercitovat
A nebola by k tomu lepšia jedna spoločná procedúra, ako kopčiť X obdobných ?
Sub Filtruj(Stlp As Integer)
Dim Radku As Long
Radku = Cells(Rows.Count, 1).End(xlUp).Row - 4
Radku = Radku + (Radku = 0 And 1)
Application.ScreenUpdating = False
If Columns(Stlp + 1).Hidden Then
Cells(5, Stlp + 1).AutoFilter
Columns(4).Resize(, 41).Hidden = False
Cells(4, 2).ClearContents
Else
Columns(4).Resize(, 41).Hidden = True
Columns(Stlp).Hidden = False
Cells(4, 2).Value = Cells(5, Stlp + 1).Value
Cells(5, Stlp + 1).Resize(Radku).AutoFilter Field:=1, Criteria1:=1
End If
Application.ScreenUpdating = True
End Sub
Private Sub BMSMainstream_Click()
Filtruj 4
End Sub
Private Sub BMSTransfer_Click()
Filtruj 6
End Sub
Private Sub BMLMainstream_Click()
Filtruj 8
End Sub
Private Sub BMLTransfer_Click()
Filtruj 10
End Sub
Private Sub MCW_Click()
Filtruj 12
End Sub
Private Sub SCW_Click()
Filtruj 14
End Sub
Private Sub FrontGril_Click()
Filtruj 16
End Sub
Private Sub BottomFrame_Click()
Filtruj 18
End Sub
Private Sub RadiantPanel_Click()
Filtruj 20
End Sub
Private Sub CoverAirOutlet_Click()
Filtruj 22
End Sub
Private Sub TV_Click()
Filtruj 24
End Sub
Private Sub GSI_Click()
Filtruj 26
End Sub
Private Sub Emura2_Click()
Filtruj 28
End Sub
Private Sub Stylish_Click()
Filtruj 30
End Sub
Private Sub SC1_Click()
Filtruj 32
End Sub
Private Sub SC2_Click()
Filtruj 34
End Sub
Private Sub SC3_Click()
Filtruj 36
End Sub
Private Sub SC4_Click()
Filtruj 38
End Sub
Private Sub SC5_Click()
Filtruj 40
End Sub
Private Sub SC6_Click()
Filtruj 42
End Sub
Sub Filtruj(Stlp As Integer)
Dim Radku As Long
Radku = Cells(Rows.Count, 1).End(xlUp).Row - 4
Radku = Radku + (Radku = 0 And 1)
Application.ScreenUpdating = False
If Columns(Stlp + 1).Hidden Then
Cells(5, Stlp + 1).AutoFilter
Columns(4).Resize(, 41).Hidden = False
Cells(4, 2).ClearContents
Else
Columns(4).Resize(, 41).Hidden = True
Columns(Stlp).Hidden = False
Cells(4, 2).Value = Cells(5, Stlp + 1).Value
Cells(5, Stlp + 1).Resize(Radku).AutoFilter Field:=1, Criteria1:=1
End If
Application.ScreenUpdating = True
End Sub
Private Sub BMSMainstream_Click()
Filtruj 4
End Sub
Private Sub BMSTransfer_Click()
Filtruj 6
End Sub
Private Sub BMLMainstream_Click()
Filtruj 8
End Sub
Private Sub BMLTransfer_Click()
Filtruj 10
End Sub
Private Sub MCW_Click()
Filtruj 12
End Sub
Private Sub SCW_Click()
Filtruj 14
End Sub
Private Sub FrontGril_Click()
Filtruj 16
End Sub
Private Sub BottomFrame_Click()
Filtruj 18
End Sub
Private Sub RadiantPanel_Click()
Filtruj 20
End Sub
Private Sub CoverAirOutlet_Click()
Filtruj 22
End Sub
Private Sub TV_Click()
Filtruj 24
End Sub
Private Sub GSI_Click()
Filtruj 26
End Sub
Private Sub Emura2_Click()
Filtruj 28
End Sub
Private Sub Stylish_Click()
Filtruj 30
End Sub
Private Sub SC1_Click()
Filtruj 32
End Sub
Private Sub SC2_Click()
Filtruj 34
End Sub
Private Sub SC3_Click()
Filtruj 36
End Sub
Private Sub SC4_Click()
Filtruj 38
End Sub
Private Sub SC5_Click()
Filtruj 40
End Sub
Private Sub SC6_Click()
Filtruj 42
End Sub
Příloha: 42709_seznam-dilu.zip (78kB, staženo 14x)
citovat42709_seznam-dilu.zip (78kB, staženo 14x)Díky za tipy, první radu už jsem zkusil a funguje. Zítra zkusím ještě ten druhý tip.
Ještě jednou moc díky za pomoc.citovat
Ještě jednou moc díky za pomoc.citovat
Ahoj, ještě jednou bych vás chtěl poprosit o pomoc. Potřebuji seřadit data v souboru "sklad_2100" použitím tlačítka v souboru "Inventurní_karty1" Tlačítko mám již vytvořené, ale nevím proč, nefunguje. Pokud ale tlačítko vložím přímo do souboru "sklad_2100", tak vše funguje. Opravdu nevím, kde může být problém.
Děkuji všem, kdo mi pomůžou.
Děkuji všem, kdo mi pomůžou.
Příloha: 42715_formatovani-test.zip (42kB, staženo 14x)
citovat42715_formatovani-test.zip (42kB, staženo 14x)Key1:=Range("I1")
musíte zmeniť na
Key1:=Workbooks("sklad_2100.xlsx").Worksheets("Sheet1").Range("I1")
alebo zmente kód na napr. takýto:
Private Sub CommandButton1_Click()
With Workbooks("sklad_2100.xlsx").Worksheets("Sheet1")
.Range("A1:J1300").Sort Key1:=.Range("I1"), Order1:=xlDescending, Header:=xlYes
End With
End Sub
Private Sub Formatovani_Click()
With Workbooks("sklad_2100.xlsx").Worksheets("Sheet1").Range("I1")
.Interior.Color = RGB(0, 255, 0)
.ColumnWidth = 20
.Value = "Rozdíl Fyz. - SAP"
.VerticalAlignment = xlTop
End With
With Workbooks("sklad_2100.xlsx").Worksheets("Sheet1").Range("J1")
.Interior.Color = RGB(255, 255, 0)
.ColumnWidth = 20
.Value = "Absol. hod."
.VerticalAlignment = xlTop
End With
With Workbooks("sklad_2100.xlsx").Worksheets("Sheet1")
.Range("I2:I1300").Formula = "=H2-F2"
.Range("J2:J1300").Formula = "=ABS(I2)"
End With
End Sub
Prípadne obe procedúry dokopy a na menej krokov:
Private Sub Formatovani_Click()
With Workbooks("sklad_2100.xlsx").Worksheets("Sheet1")
With .Range("I1:J1")
.ColumnWidth = 20
.Value = Array("Rozdíl Fyz. - SAP", "Absol. hod.")
.VerticalAlignment = xlTop
End With
.Range("I1").Interior.Color = RGB(0, 255, 0)
.Range("J1").Interior.Color = RGB(255, 255, 0)
.Range("I2:J1300").Formula = Array("=H2-F2", "=ABS(I2)")
.Range("A1:J1300").Sort Key1:=.Range("I1"), Order1:=xlDescending, Header:=xlYes
End With
End Sub
Aj tak sa mi nezdá, to vkladanie vzorcov na 1300 riadkov. Určite ? Netreba to náhodou len na taký počet riadkov, koľko je dát ? Lebo teraz to dá tie záporné hodnoty až za 0 (nuly), čo je od riadku 1300 vyššie.
Takto by mi to viacej dávalo zmysel:
Private Sub Formatovani_Click()
Dim Riadkov As Long
With Workbooks("sklad_2100.xlsx").Worksheets("Sheet1")
With .Range("I1:J1")
.ColumnWidth = 20
.Value = Array("Rozdíl Fyz. - SAP", "Absol. hod.")
.VerticalAlignment = xlTop
End With
.Range("I1").Interior.Color = RGB(0, 255, 0)
.Range("J1").Interior.Color = RGB(255, 255, 0)
Riadkov = .Cells(Rows.Count, 1).End(xlUp).Row
If Riadkov > 1 Then
.Range("I2:J" & Riadkov).Formula = Array("=H2-F2", "=ABS(I2)")
.Range("A1:J" & Riadkov).Sort Key1:=.Range("I1"), Order1:=xlDescending, Header:=xlYes
End If
End With
End Sub
musíte zmeniť na
Key1:=Workbooks("sklad_2100.xlsx").Worksheets("Sheet1").Range("I1")
alebo zmente kód na napr. takýto:
Private Sub CommandButton1_Click()
With Workbooks("sklad_2100.xlsx").Worksheets("Sheet1")
.Range("A1:J1300").Sort Key1:=.Range("I1"), Order1:=xlDescending, Header:=xlYes
End With
End Sub
Private Sub Formatovani_Click()
With Workbooks("sklad_2100.xlsx").Worksheets("Sheet1").Range("I1")
.Interior.Color = RGB(0, 255, 0)
.ColumnWidth = 20
.Value = "Rozdíl Fyz. - SAP"
.VerticalAlignment = xlTop
End With
With Workbooks("sklad_2100.xlsx").Worksheets("Sheet1").Range("J1")
.Interior.Color = RGB(255, 255, 0)
.ColumnWidth = 20
.Value = "Absol. hod."
.VerticalAlignment = xlTop
End With
With Workbooks("sklad_2100.xlsx").Worksheets("Sheet1")
.Range("I2:I1300").Formula = "=H2-F2"
.Range("J2:J1300").Formula = "=ABS(I2)"
End With
End Sub
Prípadne obe procedúry dokopy a na menej krokov:
Private Sub Formatovani_Click()
With Workbooks("sklad_2100.xlsx").Worksheets("Sheet1")
With .Range("I1:J1")
.ColumnWidth = 20
.Value = Array("Rozdíl Fyz. - SAP", "Absol. hod.")
.VerticalAlignment = xlTop
End With
.Range("I1").Interior.Color = RGB(0, 255, 0)
.Range("J1").Interior.Color = RGB(255, 255, 0)
.Range("I2:J1300").Formula = Array("=H2-F2", "=ABS(I2)")
.Range("A1:J1300").Sort Key1:=.Range("I1"), Order1:=xlDescending, Header:=xlYes
End With
End Sub
Aj tak sa mi nezdá, to vkladanie vzorcov na 1300 riadkov. Určite ? Netreba to náhodou len na taký počet riadkov, koľko je dát ? Lebo teraz to dá tie záporné hodnoty až za 0 (nuly), čo je od riadku 1300 vyššie.
Takto by mi to viacej dávalo zmysel:
Private Sub Formatovani_Click()
Dim Riadkov As Long
With Workbooks("sklad_2100.xlsx").Worksheets("Sheet1")
With .Range("I1:J1")
.ColumnWidth = 20
.Value = Array("Rozdíl Fyz. - SAP", "Absol. hod.")
.VerticalAlignment = xlTop
End With
.Range("I1").Interior.Color = RGB(0, 255, 0)
.Range("J1").Interior.Color = RGB(255, 255, 0)
Riadkov = .Cells(Rows.Count, 1).End(xlUp).Row
If Riadkov > 1 Then
.Range("I2:J" & Riadkov).Formula = Array("=H2-F2", "=ABS(I2)")
.Range("A1:J" & Riadkov).Sort Key1:=.Range("I1"), Order1:=xlDescending, Header:=xlYes
End If
End With
End Sub
Příloha: 42716_inventurni_karty1.zip (19kB, staženo 12x)
citovat42716_inventurni_karty1.zip (19kB, staženo 12x)Díky moc, to byla rychlost. 1300 řádků tam mám proto, že ve výsledném souboru bude cca 1000 řádek dat a ještě možná přibudou další, tak ať to pak nemusím přepisovat.
Ještě jednou díky moc. Už mi chybí jen jedna věc, když na to nepřijdu sám, tak se asi zase obrátím na někoho chytřejšího.citovat
Ještě jednou díky moc. Už mi chybí jen jedna věc, když na to nepřijdu sám, tak se asi zase obrátím na někoho chytřejšího.citovat
Tak to je ale potom zvláštne. Keď tam majú dáta pribúdať, načo potom makrom vkladať vždy na to isté miesto vzorce a formátovať hlavičku ? Veď to urobte raz manuálne, a nepotrebujete na to opakovane makro, zbytočne, lebo to už je vykonané.
A keď si z obyčajnej tabuľky urobíte objekt Tabuľka (Ctrl+T), tak sa budú vzorce kopírovať do ďalších pridaných riadkov automaticky samé.
Otázkou je, akým spôsobom budú pribúdať údaje.
Ak ručne, tak je potreba potom ručne (alebo makrom) reinicializovať opätovné zoradenie.
Ak pribúdajú makrom, treba túto reinicializáciu vyvolať rovno pri importe.
No a na druhej strane, ak tie úpravy potrebujete robiť opakovane na nejaký export súbor od neviem odkiaľ, tak do export/reportu nemôžete pridávať dáta. Potom to už nezodpovedá tomu reportu. A zároveň je to v rozpore toho vyššie spomínaného opakovaného formátovania.
Alebo ???
Tu máte príklad takej Tabuľky. Stačí iba skopírovať z nejakého nového reportu/exportu/výkazu nové dáta na prvý voľný riadok pod Tabuľku. Vzorce v I:J sa doplnia samé. Potom už iba na karte Údaje kliknite v skupine Zoradiť a filtrovať na Znovu použiť. Neviem, či Vám celá operácia zaberie 10 sek. V dátach ale vidím typický neduh týchto exportov - zlý formát dát. Stĺpec A musí byť formát Text (ID materiálov sú aj číselné aj textočíselné, aby to nespôsobovalo problém napr pri vyhľadávaní 0123 vs 123), C:D sú čísla ako text a majú to byť čísla.
-buď ich pri exporte (ak to ide navoliť) exportujte správne
-alebo ich pri importe (ak vôbec importujete, možno máte už hotový súbor xlsx a nie napr. csv a pod.) zformátujte
-alebo použite:
---do bunky niekde bokom dočasne napíšte 1, túto bunku dajte Ctrl+C
---označte celé stĺpce Tabuľky "tblData[[Závod]:[Sklad]]" na hlalvičke týchto stĺpcov
---pravý klik na označené - Prilepiť špeciálne - Hodnoty - Násobenie - OK
---Zmažte tú 1-tku, a sú z toho skutočné čísla.
-alebo označte najskôr v Tabuľke stĺpec Závod (opäť na hlavičke, taká malá šípka), na karte Údaje - Text na stĺpce - Ďalej - Ďalej - Dokončiť. Potom to isté urobte so stĺpcom Sklad.
Všetko sú to jednoduché operácie, a žiadne makro zatiaľ nieje potreba. Usudzujem totiž, že nieje možné použiť súbor s makrom, ak makrom z iného súboru upravujete tento xlsx. Inak by mal predsa tento súbor makro v sebe, a nemuselo by sa to riešiť cez 2 súbory.
A keď si z obyčajnej tabuľky urobíte objekt Tabuľka (Ctrl+T), tak sa budú vzorce kopírovať do ďalších pridaných riadkov automaticky samé.
Otázkou je, akým spôsobom budú pribúdať údaje.
Ak ručne, tak je potreba potom ručne (alebo makrom) reinicializovať opätovné zoradenie.
Ak pribúdajú makrom, treba túto reinicializáciu vyvolať rovno pri importe.
No a na druhej strane, ak tie úpravy potrebujete robiť opakovane na nejaký export súbor od neviem odkiaľ, tak do export/reportu nemôžete pridávať dáta. Potom to už nezodpovedá tomu reportu. A zároveň je to v rozpore toho vyššie spomínaného opakovaného formátovania.
Alebo ???
Tu máte príklad takej Tabuľky. Stačí iba skopírovať z nejakého nového reportu/exportu/výkazu nové dáta na prvý voľný riadok pod Tabuľku. Vzorce v I:J sa doplnia samé. Potom už iba na karte Údaje kliknite v skupine Zoradiť a filtrovať na Znovu použiť. Neviem, či Vám celá operácia zaberie 10 sek. V dátach ale vidím typický neduh týchto exportov - zlý formát dát. Stĺpec A musí byť formát Text (ID materiálov sú aj číselné aj textočíselné, aby to nespôsobovalo problém napr pri vyhľadávaní 0123 vs 123), C:D sú čísla ako text a majú to byť čísla.
-buď ich pri exporte (ak to ide navoliť) exportujte správne
-alebo ich pri importe (ak vôbec importujete, možno máte už hotový súbor xlsx a nie napr. csv a pod.) zformátujte
-alebo použite:
---do bunky niekde bokom dočasne napíšte 1, túto bunku dajte Ctrl+C
---označte celé stĺpce Tabuľky "tblData[[Závod]:[Sklad]]" na hlalvičke týchto stĺpcov
---pravý klik na označené - Prilepiť špeciálne - Hodnoty - Násobenie - OK
---Zmažte tú 1-tku, a sú z toho skutočné čísla.
-alebo označte najskôr v Tabuľke stĺpec Závod (opäť na hlavičke, taká malá šípka), na karte Údaje - Text na stĺpce - Ďalej - Ďalej - Dokončiť. Potom to isté urobte so stĺpcom Sklad.
Všetko sú to jednoduché operácie, a žiadne makro zatiaľ nieje potreba. Usudzujem totiž, že nieje možné použiť súbor s makrom, ak makrom z iného súboru upravujete tento xlsx. Inak by mal predsa tento súbor makro v sebe, a nemuselo by sa to riešiť cez 2 súbory.
Příloha: 
42718_sklad_2100.xlsx (15kB, staženo 17x)
citovat42718_sklad_2100.xlsx (15kB, staženo 17x)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