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
334
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
Kuvat! Dannyyn liitetty Helmi Loukasmäki, 22, on puhjennut naisena kukkaan - Some sekoaa: "Sä..."
Ooo, kaunis aikuinen nainen Helmistä on kasvanut siinä yli 80-vuotiaan Dannyn rinnalla! Katso uudet kuvat: https://ww473235- 472421
Suodatinpussin kastelemalla saa parempaa kahvia
Kokeilin niksiä ja kyllä tämä kahvi on parempaa nyt. Ei lainkaan maistu paperiselta. Huljuttelee hanan alla suppiloa pap1251770Tidätkö nainen
että suoraan sanottuna v.tut.aa että pääsit näin lähelle minua. Ei olisi oikeasti aikaa tähän mutta silti aina välillä o1001613Onkohan sinulla kaikki hyvin?
Nyt vähän sellainen outo tunne tuli. Sinun asiasi niin ei minulle toki tarvitse kertoa. Kunhan mietin...381097Mikä on kaivattusi etunimi?
Otsikossa siis on kysymys eriteltynä. Vain oikeat vastaukset hyväksytään.45975- 169964
Huikeeta, mahtavaa, ihan mielettömän upeeta
Me ostettiin talo Espanjasta. Tosin saadaan käyttää sitä vain muutama viikko vuodessa kun on monta muutakin ostajaa! M175876En kestä katsoa
Sitä miten sinusta on muut kiinnostuneita. Olen kateellinen. Siksi pitäisi lähteä pois77861Oho! Arja Koriseva paljastaa TTK:n ekasta suorasta lähetyksestä: "On vähän ärsyttävä yhtälö!"
Upea Arja Koriseva! Tsemppiä haasteelliseen tilanteeseen! Lue lisää: https://www.suomi24.fi/viihde/oho-arja-koriseva-14794