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 Subpříš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 prosím 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 prosím 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 prosím 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 prosím 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 14 hostů





