Jen tak narychlo
Příloha: 
48516_test2.zip (33kB, staženo 24x)
48516_test2.zip (33kB, staženo 24x)
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Tipy a triky pro Excel a makra VBA
< návrat zpět
Téma: Rozkopírování dat do listů
MS Excel
Téma: Rozkopírování dat do listů 
Zaslal/a Raders486 21.10.2020 8:05
Ahoj.
V listě „Celkem" je jmenný seznam a zde důležitý sloupce „Zodpovídá".
V listě „Data" jsou data, která potřebuji roztřídit do jednotlivých listů podle „Zodpovídá“.
Kód by měl vypadat takto (přeloženo do lidského jazyka 
)
Načti první jméno z listu „Celkem" ze sloupce „A"
Když najdeš toto jméno na listě „Data" ve sloupci „A" tak vyjmout všechny tyto řádky s tímto jménem a vložit je do listu se stejným jménem
(Vzhledem k tomu, že jednotlivé listy a seznam jmen na listu „Celkem" jsou tvořeny právě z listu „Data", musí se vždy alespoň jeden řádek překopírovat).
Takto to proveď u všech jmen z listu „Celkem".
Pomůže prosím někdo?
Děkuji.
Příloha: 48510_test1.rar (21kB, staženo 23x)
48510_test1.rar (21kB, staženo 23x)Ještě jednou děkuji.
Hází to však chybu ve formátu nakopírovaných datech a kód nedoběhne celý.
Zde se zastaví:
Worksheets(Sheets.Count).Range("A1:AR" & iCil) = arrCil
V příloze jsou data tak, jak tabulka vypadá před zavoláním kódu.
Můžete na to ještě mrknout, prosím?
Děkuji
Hází to však chybu ve formátu nakopírovaných datech a kód nedoběhne celý.
Zde se zastaví:
Worksheets(Sheets.Count).Range("A1:AR" & iCil) = arrCil
V příloze jsou data tak, jak tabulka vypadá před zavoláním kódu.
Můžete na to ještě mrknout, prosím?
Děkuji
Příloha: 48543_test2.rar (225kB, staženo 18x)
48543_test2.rar (225kB, staženo 18x)1. Chybu to háže, protože se snažíte zapisovat do neexistujícího list. Nevím, co jste chtěl vyřešit tímto příkazem: Worksheets(Sheets.Count).Ran...
Tímto příkazem říkáte, že chcete všechno ukládat do listu 14, který ale neexistuje. Sheets.Count je 14 a list číslo 14 tam nemáte. V závorkách musí být jméno listu, do kterého data chcete vkládat. A to jsou jednotlivá jména podle tabulky v listu Celkem.
2. Sice jste si rozšířil sloupce pro kopírování, ale nezměnil jste velikost cílového pole, takže pokud by se vám to podařilo uložit, uložily by se jen dva sloupce.
3. Opravil jsem ještě načítání hlavičky. Tak jak jste si to upravil by to hlavičku nezkopírovalo.
Vyzkoušejte a dejte vědět případné další úpravy.
Tímto příkazem říkáte, že chcete všechno ukládat do listu 14, který ale neexistuje. Sheets.Count je 14 a list číslo 14 tam nemáte. V závorkách musí být jméno listu, do kterého data chcete vkládat. A to jsou jednotlivá jména podle tabulky v listu Celkem.
2. Sice jste si rozšířil sloupce pro kopírování, ale nezměnil jste velikost cílového pole, takže pokud by se vám to podařilo uložit, uložily by se jen dva sloupce.
3. Opravil jsem ještě načítání hlavičky. Tak jak jste si to upravil by to hlavičku nezkopírovalo.
Vyzkoušejte a dejte vědět případné další úpravy.
Příloha: 48545_test3.zip (227kB, staženo 22x)
48545_test3.zip (227kB, staženo 22x)jo jo máte pravdu, chyb jsem tam nechal více a to tím jak jsem to zkoušel při krokování.
Každopádně jsem nyní odzkoušel a šlape dle představ.
Děkuji moc.
Každopádně jsem nyní odzkoušel a šlape dle představ.
Děkuji moc.
Dobrý den.
Po delší době, kdy procedura fungovala a nijak do ni nebylo zasahováno, z ničeho nic začala zase padat.
Při snaze opravit tento pád jsem zjistil, že při rozkopírováni dat do jednotlivých listů, nevezme u jména "Šrot" všechny řádky.
Mohl by jste se tedy na to prosím ještě podívat?
V příloze aktuální data.
Děkuji moc
Po delší době, kdy procedura fungovala a nijak do ni nebylo zasahováno, z ničeho nic začala zase padat.
Při snaze opravit tento pád jsem zjistil, že při rozkopírováni dat do jednotlivých listů, nevezme u jména "Šrot" všechny řádky.
Mohl by jste se tedy na to prosím ještě podívat?
V příloze aktuální data.
Děkuji moc
Příloha: 49476_reklamace_a_neshody_po_resitelich.rar (199kB, staženo 21x)
49476_reklamace_a_neshody_po_resitelich.rar (199kB, staženo 21x)Pokus makro rozkopiruj2 :
Pozor, polka kódu je tam na vytváranie neexistujúcich listov, kontrolu a mazanie dát na existujúcich listoch.
Vyskúšajte, popis urobím dodatočne.
Inak prečo nepoužijete v liste Data objekt Tabuľka a na ňu Rýchly filter (SmartFilter)? Ten bude mať jedinečné hodnoty priamo, a každé meno máte hneď na 1 klik.
Pozor, polka kódu je tam na vytváranie neexistujúcich listov, kontrolu a mazanie dát na existujúcich listoch.
Vyskúšajte, popis urobím dodatočne.
Inak prečo nepoužijete v liste Data objekt Tabuľka a na ňu Rýchly filter (SmartFilter)? Ten bude mať jedinečné hodnoty priamo, a každé meno máte hneď na 1 klik.
Příloha: 49483_reklamace_a_neshody_po_resitelich.zip (318kB, staženo 24x)
49483_reklamace_a_neshody_po_resitelich.zip (318kB, staženo 24x)Dobrý den Elninoslov. Děkuji za pomoc. Aktualizoval jsem data i proceduru a vše proběhlo jak mělo.
Nerozumím tomuto:
Pozor, polka kódu je tam na vytváranie neexistujúcich listov, kontrolu a mazanie dát na existujúcich listoch.
Vyskúšajte, popis urobím dodatočne.
ale Vaší proceduře předchází procedura, která vytváří nejprve listy, podle jmen která jsou v kontingenční tabulce na listu celkem.
Každopádně je nyní vše v pořádku.
Děkuji
Nerozumím tomuto:
Pozor, polka kódu je tam na vytváranie neexistujúcich listov, kontrolu a mazanie dát na existujúcich listoch.
Vyskúšajte, popis urobím dodatočne.
ale Vaší proceduře předchází procedura, která vytváří nejprve listy, podle jmen která jsou v kontingenční tabulce na listu celkem.
Každopádně je nyní vše v pořádku.
Děkuji
??? Mojej procedúre nič nepredchádza. Nič na vytváranie listov tam mimo mojej proc. nie je. A ak na to máte inú proc. (tá "rozkopiruj1" to nerobí), ktorú ste neuviedol, tak to nie je moja chyba.
PS: Pozerám, že som tam zabudol nepotrebný Module1 - zmažte.
Ak tam to vytváranie byť nemá, tak ten spodný cyklus
For y = 1 To UBound(arrZodp, 1)
On Error Resume Next
Set WS = Worksheets(arrZodp(y, 1))
On Error GoTo 0
If WS Is Nothing Then
Set WS = Worksheets.Add(After:=Worksheets(Worksheets.Count))
WS.Name = arrZodp(y, 1)
Else
WS.Activate
WS.UsedRange.Delete
End If
Worksheets("Data").UsedRange.Rows(1).Copy
With WS
.Cells(1, 1).PasteSpecial Paste:=xlPasteAll
.Cells(1, 1).PasteSpecial Paste:=xlPasteColumnWidths
.Cells(1, 1).Select
.Cells(2, 1).Resize(arrPocty(y, 1), Sloupcu).Value = AIZ(y)(1)
End With
Set WS = Nothing
Next y
nahraďte takýmto
For y = 1 To UBound(arrZodp, 1)
Worksheets(arrZodp(y, 1)).Cells(2, 1).Resize(arrPocty(y, 1), Sloupcu).Value = AIZ(y)(1)
Next y
a zmažte deklaráciu na konci prvého riadku
, WS As Worksheet
A ten Rýchly filter ste neskúšal? Označte si celú tbl Data, Ctrl+T, nechajte zaškrtnuté že obsahuje hlavičky, v menu Návrh vyberte Vložiť rýchly filter, vyberte Zodpovídá, OK. A teraz kliknutím na meno sa tbl vyfiltruje, prípadne si môžete zapnúť hore aj viacnásobný výber. Ak nevyhovuje tak nič.
PS: Pozerám, že som tam zabudol nepotrebný Module1 - zmažte.
Ak tam to vytváranie byť nemá, tak ten spodný cyklus
For y = 1 To UBound(arrZodp, 1)
On Error Resume Next
Set WS = Worksheets(arrZodp(y, 1))
On Error GoTo 0
If WS Is Nothing Then
Set WS = Worksheets.Add(After:=Worksheets(Worksheets.Count))
WS.Name = arrZodp(y, 1)
Else
WS.Activate
WS.UsedRange.Delete
End If
Worksheets("Data").UsedRange.Rows(1).Copy
With WS
.Cells(1, 1).PasteSpecial Paste:=xlPasteAll
.Cells(1, 1).PasteSpecial Paste:=xlPasteColumnWidths
.Cells(1, 1).Select
.Cells(2, 1).Resize(arrPocty(y, 1), Sloupcu).Value = AIZ(y)(1)
End With
Set WS = Nothing
Next y
nahraďte takýmto
For y = 1 To UBound(arrZodp, 1)
Worksheets(arrZodp(y, 1)).Cells(2, 1).Resize(arrPocty(y, 1), Sloupcu).Value = AIZ(y)(1)
Next y
a zmažte deklaráciu na konci prvého riadku
, WS As Worksheet
A ten Rýchly filter ste neskúšal? Označte si celú tbl Data, Ctrl+T, nechajte zaškrtnuté že obsahuje hlavičky, v menu Návrh vyberte Vložiť rýchly filter, vyberte Zodpovídá, OK. A teraz kliknutím na meno sa tbl vyfiltruje, prípadne si môžete zapnúť hore aj viacnásobný výber. Ak nevyhovuje tak nič.
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