Zdravim,
Potrebuji zase poradit, jak udelat kod pro VBA ktery mi kdyz je nejaka bunka ve sloupci plna zapsal data do bunky v jinem liste, pokud je prázdná at zkontroluje dalsi bunku smerem dolu. Samozrejme kdyz zapise data do toho jineho listu musi se posunout rase o radek niz aby mel kam zapsat dalsi data.
Jde o to aby pak ve vysledku nebyly prazde bunky mezi rádky. Sortování nejde pouzit aby ty data byly za sebou jak maji byt podle toho prvniho listu.
/změna nadpisu
/mikel
Pomozte s VBA kódem
Re: Maly help
zkus toto máš to i popsaný pro snadnější úpravu
příště prosím "malý help" konkrétněji třeba alespoň VBA nebo excel - makro nebo něco konkrétnějšího
Kód: Vybrat vše
Sub vypsat()
Dim i As Long 'definice i jako dlouhe cislo pro pripad Option Explicit
Dim radek As Long 'radek jako dlouhy cislo
radek = 1 'nastaveni radek jako 1
For i = 1 To 65536 'pocita od 1 do 65536(posledni radek excel)
If Sheets("List1").Cells(i, 1) <> "" Then 'pokud na List1 bunce na poloze
'i (pocitadlo) ve sloupci 1 bude neco jinyho nez prazdno tak:
Sheets("List2").Cells(radek, 1) = Sheets("List1").Cells(i, 1)
'List2 bunka v radku radek, sloupec1 priradit porovnavanou hodnotu
radek = radek + 1 'pocitadlo radku aby nebyly mezery probehne pouze pri vyplneni
End If 'konec podnínky
Next 'konec pocitadla
End Sub
příště prosím "malý help" konkrétněji třeba alespoň VBA nebo excel - makro nebo něco konkrétnějšího
uživatel odstaven
Re: Pomozte s VBA kódem
Doporučuji jednu drobnost :-)
xx = Cells.SpecialCells(xlLastCell).Row ' zjisti posledni radek v listu. xlLastCell = stejene jako klavesa CTRL+END
for i = 1 to xx
místo:
for i = 1 to 65536
Pravděpodobně nebudeš mít plný list až do konce a v případě běžných tabulek tak nax to 10tisíc řádek to makro urychlí. Nebude muset zbytečně procházet prázdné buňky.
xx = Cells.SpecialCells(xlLastCell).Row ' zjisti posledni radek v listu. xlLastCell = stejene jako klavesa CTRL+END
for i = 1 to xx
místo:
for i = 1 to 65536
Pravděpodobně nebudeš mít plný list až do konce a v případě běžných tabulek tak nax to 10tisíc řádek to makro urychlí. Nebude muset zbytečně procházet prázdné buňky.
- mike007
- Master Level 7.5
- Příspěvky: 5860
- Registrován: srpen 07
- Bydliště: Pardubice
- Pohlaví:
- Stav:
Offline
- Kontakt:
Re: Pomozte s VBA kódem
vashut : Co když se jeho záložky nejmenují List1, List2 ? Nebylo by lepší nabídnout jinou metodu?
To je jen rejpavá. Promiň
To je jen rejpavá. Promiň
Nejlepší hra je Excel!
• Pravidla fóra PC-help • Jak označit téma za vyřešené
»»»»»»»»»»»»»»»»»»»»»»»
UPOZORNĚNÍ - můj Skype, Soukromé zprávy či email neslouží jako tech. podpora.
Dotazy pište do fóra. Od toho tu je.
• Pravidla fóra PC-help • Jak označit téma za vyřešené
»»»»»»»»»»»»»»»»»»»»»»»
UPOZORNĚNÍ - můj Skype, Soukromé zprávy či email neslouží jako tech. podpora.
Dotazy pište do fóra. Od toho tu je.
Re: Pomozte s VBA kódem
Když už do toho chce takhle rejpat :-) tak by to mohlo vypadat třebas takhle:
Sub vypsat()
Dim i As Long 'definice i jako dlouhe cislo pro pripad Option Explicit
Dim radek As Long 'radek jako dlouhy cislo
radek = 1 'nastaveni radek jako 1
' Rejpalka
aa = ActiveSheet.Index '- zjisti index aktualniho listu
If aa < Worksheets.Count Then '- zjisti jestli neni posledni
Else
Worksheets.Add after:=Sheets(aa) '- prida dalsi list za list aa
End If
bb = aa + 1 ' - index listu o jeden vice
' konec rejpalky :-)
For i = 1 To Cells.SpecialCells(xlLastCell).Row 'pocita od 1 do 65536(posledni radek excel)
If Worksheets(aa).Cells(i, 1) <> "" Then 'pokud na List1 bunce na poloze
'i (pocitadlo) ve sloupci 1 bude neco jinyho nez prazdno tak:
Worksheets(bb).Cells(radek, 1) = Worksheets(aa).Cells(i, 1)
'List2 bunka v radku radek, sloupec1 priradit porovnavanou hodnotu
radek = radek + 1 'pocitadlo radku aby nebyly mezery probehne pouze pri vyplneni
End If 'konec podnínky
Next 'konec pocitadla
End Sub
Sub vypsat()
Dim i As Long 'definice i jako dlouhe cislo pro pripad Option Explicit
Dim radek As Long 'radek jako dlouhy cislo
radek = 1 'nastaveni radek jako 1
' Rejpalka
aa = ActiveSheet.Index '- zjisti index aktualniho listu
If aa < Worksheets.Count Then '- zjisti jestli neni posledni
Else
Worksheets.Add after:=Sheets(aa) '- prida dalsi list za list aa
End If
bb = aa + 1 ' - index listu o jeden vice
' konec rejpalky :-)
For i = 1 To Cells.SpecialCells(xlLastCell).Row 'pocita od 1 do 65536(posledni radek excel)
If Worksheets(aa).Cells(i, 1) <> "" Then 'pokud na List1 bunce na poloze
'i (pocitadlo) ve sloupci 1 bude neco jinyho nez prazdno tak:
Worksheets(bb).Cells(radek, 1) = Worksheets(aa).Cells(i, 1)
'List2 bunka v radku radek, sloupec1 priradit porovnavanou hodnotu
radek = radek + 1 'pocitadlo radku aby nebyly mezery probehne pouze pri vyplneni
End If 'konec podnínky
Next 'konec pocitadla
End Sub
- mike007
- Master Level 7.5
- Příspěvky: 5860
- Registrován: srpen 07
- Bydliště: Pardubice
- Pohlaví:
- Stav:
Offline
- Kontakt:
Re: Pomozte s VBA kódem
vashut : Správně
Jenda70 : Taky řešení
//Před pár minutami jsem dopsal a odladil prográmek pro mašinku na zakládání pružinek do automatu, ale na tohle doslova čumím jak Tatar na biftek. Klobouk dolů, kdo umí, umí...
//Karlos
Jenda70 : Taky řešení
//Před pár minutami jsem dopsal a odladil prográmek pro mašinku na zakládání pružinek do automatu, ale na tohle doslova čumím jak Tatar na biftek. Klobouk dolů, kdo umí, umí...
//Karlos
Nejlepší hra je Excel!
• Pravidla fóra PC-help • Jak označit téma za vyřešené
»»»»»»»»»»»»»»»»»»»»»»»
UPOZORNĚNÍ - můj Skype, Soukromé zprávy či email neslouží jako tech. podpora.
Dotazy pište do fóra. Od toho tu je.
• Pravidla fóra PC-help • Jak označit téma za vyřešené
»»»»»»»»»»»»»»»»»»»»»»»
UPOZORNĚNÍ - můj Skype, Soukromé zprávy či email neslouží jako tech. podpora.
Dotazy pište do fóra. Od toho tu je.
Re: Pomozte s VBA kódem
jen k tomu ještě doplnim proč jsem to tak psal "List1" odpověď byla ráno a ve spěchu a když už je rejpavá:
každý ten způsob má svoje výhody a nevýhody a jelikož neznám uživatelovu zkušenost s programováním tak jsem volil druhej níže popsanej způsob
1. způsob Sheets(1).něco... má výhodu, že je kratší a nezáleží na jméně listu, je to vždy první v pořadí a i když normální první je skrytej (to považuju za nevýhodu když uživatel dostane již hotový sešit a neví, co se dělo) pak nemusí kod fungovat korektně. pak také pokud se listy prohoděj už to zase nefunguje
2. způsob Sheets("List1").něco... je delší zápis ale pro běžného uživatele naprosto tupovzdorný(nenarážim na nikoho) a ještě jsem neviděl, že by to někdo zplet. A může se listu libovolně měnit pořadí.
nevýhody: přejmenování = nefungčnost
je možný, že jsem na nějákou výhodu/nevýhodu zapoměl ale to kdyžtak doplnim až mě to trkne
hlavní důvod volby 2 je to, že jsem předpokládal přesun listu na první pozici
každý ten způsob má svoje výhody a nevýhody a jelikož neznám uživatelovu zkušenost s programováním tak jsem volil druhej níže popsanej způsob
1. způsob Sheets(1).něco... má výhodu, že je kratší a nezáleží na jméně listu, je to vždy první v pořadí a i když normální první je skrytej (to považuju za nevýhodu když uživatel dostane již hotový sešit a neví, co se dělo) pak nemusí kod fungovat korektně. pak také pokud se listy prohoděj už to zase nefunguje
2. způsob Sheets("List1").něco... je delší zápis ale pro běžného uživatele naprosto tupovzdorný(nenarážim na nikoho) a ještě jsem neviděl, že by to někdo zplet. A může se listu libovolně měnit pořadí.
nevýhody: přejmenování = nefungčnost
je možný, že jsem na nějákou výhodu/nevýhodu zapoměl ale to kdyžtak doplnim až mě to trkne
hlavní důvod volby 2 je to, že jsem předpokládal přesun listu na první pozici
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 41 hostů