Pitäisi saada Taul1:een namiska, joka kopioisi Taul2:een, mikäli D-sarakkeessa on luku, samalla rivillä olevat B- ja C-solut. B- ja C-soluja pitäisi kopsata niin monta kuin D-sarakkeen luku näyttää.
Solujen muotoilujen tulisi säilyä. Samassa solussa on muotoiluna lihavointi, kursivointi ja osa solun sisällöstä on ilman muotoilua.
Esim. Taul1
B2=Matti, C3=Meikäläinen, D3= 2
B15=Maija, C15=Mehiläinen, D15= 3
Taul2(A1:B5)
Matti Meikäläinen
Matti Meikäläinen
Maija Mehiläinen
Maija Mehiläinen
Maija Mehiläinen
Kopiointia
pom
7
351
Vastaukset
moduuliin ja liität makron nappiin
Sub KopioiJaSiirrä()
Dim vika As Integer
Dim vika2 As Integer
Dim kopio As Range
Dim i As Integer
On Error Resume Next
Taul1.Activate
Sheets("Taul2").Range("A1:B" & Sheets("Taul2").Range("A65536").End(xlUp).Row) = ""
vika = Sheets("Taul1").Range("D65536").End(xlUp).Row
For Each solu In Sheets("Taul1").Range("D1:D" & vika)
If solu "" And IsNumeric(solu) Then
Set kopio = solu.Offset(0, -2).Resize(1, 2)
For i = 1 To solu.Value
vika2 = Sheets("Taul2").Range("A1").End(xlDown).Row
If vika2 = 0 Then
vika2 = 1
Else
vika2 = vika2 1
End If
kopio.Copy Destination:=Sheets("Taul2").Range("A" & vika2)
Next i
End If
Next
End Sub- pom
pelittää. Suuret kiitokset!
- pom2
Minkäs takia tämä ei toimi enää rivin 32767 jälkeen? Tarvis ois saada 140 000 riviä pelittämään. Käytössä Excel 2007.
niin se kehitys kulkee eteenpäin.
aikanaan Excelissä oli max 65536 riviä.
versiossa 2007 rivimäärä kasvoi max 1,048,576 riviin.
koodissani olen käyttänyt Integer muuttujaa max 32767
nyt se kuitenkin pitäisi muuttaa Long tyyppiksi max 2147483647
Sub KopioiJaSiirrä()
Dim vika As Long
Dim vika2 As Long
Dim kopio As Range
Dim i As Long
On Error Resume Next
Taul1.Activate
Sheets("Taul2").Range("A1:B" & Sheets("Taul2").Range("A65536").End(xlUp).Row) = ""
vika = Sheets("Taul1").Range("D65536").End(xlUp).Row
For Each solu In Sheets("Taul1").Range("D1:D" & vika)
If solu "" And IsNumeric(solu) Then
Set kopio = solu.Offset(0, -2).Resize(1, 2)
For i = 1 To solu.Value
vika2 = Sheets("Taul2").Range("A1").End(xlDown).Row
If vika2 = 0 Then
vika2 = 1
Else
vika2 = vika2 1
End If
kopio.Copy Destination:=Sheets("Taul2").Range("A" & vika2)
Next i
End If
Next
End Sub
Keep EXCELing
@Kunde- pom2
kunde kirjoitti:
niin se kehitys kulkee eteenpäin.
aikanaan Excelissä oli max 65536 riviä.
versiossa 2007 rivimäärä kasvoi max 1,048,576 riviin.
koodissani olen käyttänyt Integer muuttujaa max 32767
nyt se kuitenkin pitäisi muuttaa Long tyyppiksi max 2147483647
Sub KopioiJaSiirrä()
Dim vika As Long
Dim vika2 As Long
Dim kopio As Range
Dim i As Long
On Error Resume Next
Taul1.Activate
Sheets("Taul2").Range("A1:B" & Sheets("Taul2").Range("A65536").End(xlUp).Row) = ""
vika = Sheets("Taul1").Range("D65536").End(xlUp).Row
For Each solu In Sheets("Taul1").Range("D1:D" & vika)
If solu "" And IsNumeric(solu) Then
Set kopio = solu.Offset(0, -2).Resize(1, 2)
For i = 1 To solu.Value
vika2 = Sheets("Taul2").Range("A1").End(xlDown).Row
If vika2 = 0 Then
vika2 = 1
Else
vika2 = vika2 1
End If
kopio.Copy Destination:=Sheets("Taul2").Range("A" & vika2)
Next i
End If
Next
End Sub
Keep EXCELing
@KundeVaan eipä näytä toimivan ollenkaan Long tyypillä.
pom2 kirjoitti:
Vaan eipä näytä toimivan ollenkaan Long tyypillä.
korjasin noi soluosoitteet isommiksi
ainakin mulla pelaa v 2010
Sub KopioiJaSiirrä()
Dim vika As Long
Dim vika2 As Long
Dim kopio As Range
Dim i As Long
On Error Resume Next
Taul1.Activate
Sheets("Taul2").Range("A1:B" & Sheets("Taul2").Range("A1045876").End(xlUp).Row) = ""
vika = Sheets("Taul1").Range("D1045876").End(xlUp).Row
For Each solu In Sheets("Taul1").Range("D1:D" & vika)
If solu "" And IsNumeric(solu) Then
Set kopio = solu.Offset(0, -2).Resize(1, 2)
For i = 1 To solu.Value
vika2 = Sheets("Taul2").Range("A1045876").End(xlUp).Row
If vika2 = 0 Then
vika2 = 1
Else
vika2 = vika2 1
End If
kopio.Copy Destination:=Sheets("Taul2").Range("A" & vika2)
Next i
End If
Next
End Sub
- pom2
No nyt toimii! Kiitos nopeasta toiminnasta!
Ketjusta on poistettu 0 sääntöjenvastaista viestiä.
Luetuimmat keskustelut
Anteeksi mies
En vaan osaa kohdata sinua ja olla normaali. En tiedä mikä vaivaa. Samaan aikaan tekee mieli tulla lähelle ja kuitenkin589717Mietin aina vain
Minä niin haluaisin nähdä sinut. Ei tuo yhden ainoan kuvan katsominen paljon helpota... Miksi sinä et voisi olla se roh174071Hetken jo luulin, että en ikävöi sinua koko aikaa
Mutta nyt on sitten taas ihan hirveä ikävä jotenkin. Tiedätköhän sinä edes, kuinka peruuttamattomasti minä olen sinuun r323346Kysely lieksan miehille
Olemme tässä pohtineet tällaista asiaa, että miten on. Tästä nyt on paljon ollut juttua julkisuudessakin aina sanomaleht942593Palstan henkisesti sairaat ja lihavat
Täällä on sairaita, työttömiä ihmisiä kirjoittelemassa joilla ei ole tarkoituksena kuin satuttaa ihmisiä. Jos eksyt pals1142110Outoa että Trump ekana sanoutui irti ilmastosopimuksesta
kun Kaliforniaa riepottelee siitä johtuvat tuhoisat maastopalot. Hirmumyrskytkin ovat USA:ssa olleet tuhoisia.3982022Saan kengurakkaan kotiin viikon päästä
Mitä tapahtui? Martina hehkutti tätä stoorissaan reilu viikko sitten, mutta eipä aussimiestä Suomessa näkynyt, vaan tapa2441535FinFamin ryhmät
Älkää hyvät ihmiset luottako tähän tahoon. Ryhmiä on, mutta eivät ne toimi. Ihmisiä savustetaan ulos, vaikka näissä piir01351Osmo Peltola voitti ansaitusti Kultaisen Venlan - Kirvoitti yleisöltä mahtavan reaktion!
JEE, onnea Osmo! Osmo Peltola voitti Vuoden esiintyjän Kultainen Venla -palkinnon. Isä-Peltsin ja Osmon luontoseikkailu731168Olen vähän
Hysteerinen se on totta. Etkai ymmärrä miten syvästi tunnen sinua kohtaan. Ja olet aina lähelläni. Olet osa jo jotain. I101135