Mulla on excel taulukko, jossa on yli 4000 riviä dataa. Miten voin valita näistä automaattisesti vaikka joka toisen? Entäs vaikka joka viidennen? Käsipelissä menee ikä ja terveys, kun näitä taulukoita on sellanen 50 kpl.
Joka toisen rivin valinta?
Jukkis
56955
0Äänestä
Muut lukivat myös
Odottaa vastausta
Näihin keskusteluihin ei ole vielä vastattu. Ole ensimmäinen.
Vastaukset 5
Vanhimmat
aika helposti mikäli se auttaisi tuohon ongelmaan. Seuraava koodi kopioi Taulukko-välilehdestä joka 5. rivin välilehteen Aputaulukko:
-----------------------
Sub KopioiRivejä()
'
' KopioiRivejä Macro
' Macro recorded 4.11.2004 by Excelit.fi
'
'
Sheets("Taulukko").Select
Range("A1").Select
Sheets("Aputaulukko").Select
Range("A1").Select
Dim Rivi As Long
For Rivi = 5 To 4000 Step 5
Sheets("Taulukko").Select
Range(Rivi & ":" & Rivi).Select
Selection.Copy
Sheets("Aputaulukko").Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Next Rivi
End Sub
-----------------------
Kiitos paljon macron pätkästä!!
Testasin 4000 rivillä ja noin 20x nopeampi...
Sub Kopioi()
Dim Alue As Variant
Dim Vika As Integer
Dim eka As Integer
Dim aika1 As Date
Application.ScreenUpdating = False
Sheets("Taulukko").Activate
Vika = Range("A65536").End(xlUp).Row
eka = 1
For Each solu In Range("A1:A" & Vika)
If (solu.Row \ 5 = solu.Row / 5) Then
Range("Aputaulukko!A" & eka & ":N" & eka) = solu.EntireRow.Value
eka = eka 1
End If
Next solu
Application.ScreenUpdating = True
End Sub
tuo sinänsä hyvä koodi on nopeampi koska rivien muotoilut eivät pysy siirrossa mukana. Esimerkiksi päivämäärät, kellonajat, laskentakaavat yms. muotoilua vaativat tiedot eivät näy aputaulukossa välttämättä oikein mikäli sitä ei ole esimuotoiltu samoin.
Toki jos se riittää että pelkät tiedot siirretään riveiltä niin silloin tuo on luonnollisesti noin kaksi kertaa nopeampi jos myös ensimmäiseen koodiin laittaa näytönpäivityksen pois päältä.
Muotoilut mukana n.2 x nopeampi.
No en tässä nyt mihinkään nopeuskisaan aio ketään haastaa, mutta yleensäkin kannatta käyttää excelin omia jutskia jos haluaa nopeutta. Kaikkein hitain vaihtoehto yleensä on for- next silmukkka.
Sub Kopioi()
Dim Alue As Variant
Dim Vika As Integer
Dim eka As Integer
Application.ScreenUpdating = False
Sheets("Taul1").Activate
Vika = Range("A65536").End(xlUp).Row
eka = 2
For Each solu In Range("A1:A" & Vika)
If (solu.Row \ 5 = solu.Row / 5) Then
solu.EntireRow.Copy Destination:=Range("Taul2!A" & eka & ":N" & eka)
eka = eka 1
End If
Next solu
Application.ScreenUpdating = True
End Sub