MS Excel - VBA - Kopie řádku z Listu 1 do Listu 2

[petrfilipi]

Dobrý den.

Potřeboval bych v Excelu zkopírovat každý devátý řádek z Listu 1 do Listu 2. Myslel jsem že to udělám takto:

radek_20m=2
For i = 2 To 262453 Step 9
list2.rows (radek_20m) = list1.rows (i)
radek_20m = radek_20m+1
Next i

Jenže druhý list je prázdný, nic se nezkopíruje. Můžu to kopírovat tak, že zkopíruju jednotlivé buňky vybraného řádku, ale to je dost pomalé.

Netušíte někdo, prosím, kde může být chyba?

Děkuji.

Petr Filipi

[holous-morous]

Vyzkoušej toto, pokud ti to bude vyhovovat, tak si to uprav.
Maká to na Off2003 v pohodě.
-----------------------------------------------------------------------

Kód: Vybrat vše

Option Explicit

Private Sub ToToJe_OK_Click()
Dim i, x

For i = 9 To 27 Step 9
       Sheets("List2").Select
    x = x + 1
     Worksheets("List2").Rows(i).Copy
       Sheets("List1").Select
     Range("A" & x).Select
       ActiveSheet.Paste
     Application.CutCopyMode = False
Next i
i = 0
x = 0
End Sub

-----------------------------------------------------------------------

[obcasny_navstevnik]

Procedura VBA, prace s objektem:

Kód: Vybrat vše

Option Explicit

Sub PrenesRadky9()
  Dim SOfsR As Long, TOfsR As Long
  Dim SRow As Range, TRow As Range
  Set SRow = Worksheets("list1").Range("2:2")
  Set TRow = Worksheets("list2").Range("2:2")
  For SOfsR = 2 To 262453 Step 9
    TRow.Offset(TOfsR, 0).Value = SRow.Offset(SOfsR - 2, 0).Value
    TOfsR = TOfsR + 1
  Next SOfsR
  Set SRow = Nothing
  Set TRow = Nothing
End Sub

[petrfilipi]

Díky, ale je to skoro stejně pomalé jako když najedu na požadovaný řádek a v cyklu dám kopírovat buňku A-F do jiného řádku jiného listu. Navíc to furt problikává (jak to přepíná mezi listy) a nedovedu si představit, že bych takto kopíroval 22.000 řádků. Ach jo, a přitom je to přece logické, že
list2.rows (radek_20m) = list1.rows (i)
by mělo fungovat.

Nicméně díky za radu.

Uděllám to asi tak, že zkopíruji celý list do jiného listu a pak tam budu řádky odspodu mazat, protože příkaz
list1.rows (i).delete
funguje.

Petr Filipi

[obcasny_navstevnik]

Nevzdychej, pouzij proceduru pracujici s objektem

[holous-morous]

Seš ufňukanej jak stará blažková...

Vraž tento příkaz před proceduru For i=..... a je to

Application.ScreenUpdating = False

Taky by jsi se měl podívat do nápovědy a banality řešit sám...

[obcasny_navstevnik]

to holous-morous:
Pouziti prikazu:

Kód: Vybrat vše

Worksheets("List2").Rows(i).Copy
Sheets("List1").Select
Range("A" & x).Select
ActiveSheet.Paste
Application.CutCopyMode = False

je v principu pomale: (kopirovat radek, vybrat na jiny list, vybrat cilovy radek, vlozit) a ani prikaz Application.ScreenUpdating = False proceduru moc nezrychli, je nutno vyuzit to, co je VBA - objetovy programovaci jazyk.

[holous-morous]

To obcasny_navstevnik :

Asi můžeš mít pravdu, už v tom dlouho nedělám, tak jsem asi vyšel z cviku...
Nic není věčně...ani láska k jedné slečně...

[petrfilipi]

Uz jdu na to. Díky.

[petrfilipi]

Tak ten kód s objekty funguje.
Díky.

[holous-morous]

' Dotaz zněl : Potřeboval bych v Excelu zkopírovat každý devátý řádek z Listu 1 do Listu 2.

Doplním "obcasny_navstevnik" i pro "petrfilipi" : - kód upraven
číslo : 262453 - není dělitelné číslem 9
takto upravené - otestováno a OK...

Kód: Vybrat vše

Sub PrenesRadky9()
  Dim SOfsR As Long, TOfsR As Long
  Dim SRow As Range, TRow As Range
  Set SRow = Worksheets("list1").Range("1:1")   ' <------ zmena
  Set TRow = Worksheets("list2").Range("1:1")   ' <------ zmena
    On Error Resume Next           ' <-------------------- nutne pro osetreni chyb
  For SOfsR = 1 To 262453 Step 9
    TRow.Offset(TOfsR, 0).Value = SRow.Offset(SOfsR - 2, 0).Value
    TOfsR = TOfsR + 1
  Next SOfsR
  Set SRow = Nothing
  Set TRow = Nothing
End Sub

[obcasny_navstevnik]

to holous-morous:
Tazatel v ukazce naznacil, ze ma zajem kopirovat pocinaje druhym radkem: For i = 2 To... na dalsi list pocinaje take druhym radkem: radek_20m=2
Pro smycku For neni podstatne, zda koncova hodnota je delitelna 9, pokud po posledni inkrementaci je prekrocena koncova hodnota, smycka je ukoncena.
Pouziti prikazu On Error Resume Next - proc? V Excelu 2007 pocet radku nebude prekrocen. A kdyz uz je pouzit, mel by byt ukoncen, nejak takhle:

Kód: Vybrat vše

  For SOfsR = 2 To 262453 Step 9
  On Error Resume Next
    TRow.Offset(TOfsR, 0).Value = SRow.Offset(SOfsR - 2, 0).Value
    TOfsR = TOfsR + 1
   If Err.Number <> 0 Then MsgBox "blabla": Err.Clear: Exit For
   On Error GoTo 0
  Next SOfsR

Zrejme pri overovani doslo k chybe v dusledku neupravene hodnoty offsetu v Tve uprave:
For SOfsR = 1 To 262453 Step 9
TRow.Offset(TOfsR, 0).Value = SRow.Offset(SOfsR - 2, 0).Value
a ne pro nedelitelnost koncove hodnoty.

[holous-morous]

To obcasny_navstevnik :

Ty řádky (kde a kam) to si opraví on. Test jsem dělal v Off2003 a došlo k chybě. Test byl původně v tvé navržené úpravě a ještě mi dělal jednu chybu a to ve zdrojáku mazal data v buňkách...to jen pro formu.
On Errror Resume Next - je proto, aby nekončil na nějaké chybě, ale dokončil cyklus, což bez toho nejde. V tomto testu bylo OK.

Jinak ošetřování chyb je jeden směr, který jsi už tady naznačil, já používám 2 typy, dle toho jak to vynuceno testy...ale nebudu se s tebou tady tahat o kopějku, byl by z toho jen měděný drát a nic víc...
A už na to házím bobek...patent na rozum je na tobě...hoj.

[obcasny_navstevnik]

to holous-morous:
Namisto rozumne diskuse predvadis urazenou jesitnost.
tebou navrzena uprava:

Kód: Vybrat vše

...
  Set SRow = Worksheets("list1").Range("1:1")   ' <------ zmena
  Set TRow = Worksheets("list2").Range("1:1")   ' <------ zmena
    On Error Resume Next           ' <-------------------- nutne pro osetreni chyb
  For SOfsR = 1 To 262453 Step 9
    TRow.Offset(TOfsR, 0).Value = SRow.Offset(SOfsR - 2, 0).Value
...

zcela zakonite hned pri prvnim prubehu smyckou (po deaktivaci On Error...) vyvola chybove hlaseni:
Run-time error '1004':
Application-defined or object defined error
v dusledku neupravene casti kodu ...= SRow.Offset(SOfsR - 2, 0).Value
nebot SRow je nastaveno na 1. radek a ofset nabyva hodnoty -1.
A to nijak nesouvisi s patentem na rozum, pouze jde o tvou nepozornost a namisto vyhledani a opravy chyby v kodu pouzijes On Error....