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
373
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
Kannattaako suomalaisen duunarin enää äänestää vasemmistopuolueita
sillä eivät ne tunnu kovasti ajavan suomi-duunarin etuja. Jos katsotaan Vasemmistoliittoa, niin sehän on ihan feministi1755625Jaaha, sitä on vasemmistoryhmä käynyt häiriköimässä Purran kodin vieressä
On näköjään iso lakana levitetty puiden väliin, jossa lukee mm. "Haista vi*** Riikka Purra". Tunkekaa leikkaukset pers..1035574Professori: Maahanmuuttajien rikollisuutta hyssytellään - hävytöntä
Kriminologi Jukka Savolaisen mukaan ikä ja vaikeat olosuhteet eivät riitä selitykseksi. – Tutkitun tiedon valossa sanoi1804548Mistä kummasta voi johtua se, että vasemmistolaiset usein häpeää itseään
voiko se johtua esim. köyhyydestä? Ja tästä on siis ihan suomalainen tutkimus olemassa. "Suomalainen tutkimus osoittaa514013Sanna-kulttilaiset hehkuttaa edelleen Marinia, vaikka esim. Sote oli susi jo syntyessään
mutta kulttilaiset eivät ole järjen jättiläisiä, ja sanoihin Lasse Lehtinenkin, että Suomessa on pohjoismaiden tyhmimmät613890Marin teki sen mihin muut eivät pystyneet, vei susi-Soten maaliin
ja sitten hävittyjen vaalien jälkeen lähtikin vastuuta pakoon...... "Professori: sote-uudistus on täysi susi. Sosiaali303548Saatoin tehdä elämäni isoimman virheen
Otsikko kertoo kaiken. Miksei kaikki voi olla yksinkertaisempaa?1271264Jotenkin tämä
tilanne taas eskaloitui ja saat mut roikkumaan täällä palstalla. Turhaan. Ei nämä tekstit sua koskaan tavoita. 😭33940- 17938
Kivitippu Forenomille
Ei tiedä itkeäkö vai nauraa kun taas joukolla vakuutetaan kansainvälisten turistien ryntäystä kivitippuun, ja vielä rake102898