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

C++, C#, Visual Basic, Delphi, Perl a ostatní

Moderátor: Moderátoři Živě.cz

Odeslat příspěvekod petrfilipi 28. 1. 2010 12:57

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
petrfilipi
Junior

Odeslat příspěvekod holous-morous 28. 1. 2010 13:52

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

-----------------------------------------------------------------------
Naposledy upravil holous-morous dne 28. 1. 2010 15:37, celkově upraveno 1
holous-morous
Junior
Uživatelský avatar

Odeslat příspěvekod obcasny_navstevnik 28. 1. 2010 14:04

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
Naposledy upravil obcasny_navstevnik dne 28. 1. 2010 14:08, celkově upraveno 1
obcasny_navstevnik
Junior

Odeslat příspěvekod petrfilipi 28. 1. 2010 14:06

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
petrfilipi
Junior

Odeslat příspěvekod obcasny_navstevnik 28. 1. 2010 14:09

Nevzdychej, pouzij proceduru pracujici s objektem
obcasny_navstevnik
Junior

Odeslat příspěvekod holous-morous 28. 1. 2010 14:34

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...
holous-morous
Junior
Uživatelský avatar

Odeslat příspěvekod obcasny_navstevnik 28. 1. 2010 14:42

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.
obcasny_navstevnik
Junior

Odeslat příspěvekod holous-morous 28. 1. 2010 14:59

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ě... :lol:
holous-morous
Junior
Uživatelský avatar

Odeslat příspěvekod petrfilipi 28. 1. 2010 15:26

Uz jdu na to. Díky.
petrfilipi
Junior

Odeslat příspěvekod petrfilipi 28. 1. 2010 15:33

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

Odeslat příspěvekod holous-morous 28. 1. 2010 15:36

' 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
holous-morous
Junior
Uživatelský avatar

Odeslat příspěvekod obcasny_navstevnik 28. 1. 2010 16:22

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.
obcasny_navstevnik
Junior

Odeslat příspěvekod holous-morous 28. 1. 2010 19:22

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.
holous-morous
Junior
Uživatelský avatar

Odeslat příspěvekod obcasny_navstevnik 28. 1. 2010 20:06

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....
obcasny_navstevnik
Junior


Kdo je online

Uživatelé procházející toto fórum: Žádní registrovaní uživatelé a 0 návštevníků