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
371
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
SDP jo 100 % suositumpi kuin persut
Kertoo Hesarin uusin kannatuskysely. Demareiden kannatus on miltei tuplat verrattuna persuihinl. Suomen kansa ei selväst29414647Valtavasti suomalaisia asunnottomina, mutta ei yhtään somalia
tai muuta kehitysmaalaista. Mites tässä näin kävi? Tiedän hyvin, että esim. somaleita lentää ulos mm. Hekan asunnoista,1674177PS ylivoimainen nousija myös HS:n gallupissa, SDP laskee taas
https://www.verkkouutiset.fi/a/hs-gallup-sdpn-suosio-laskee-ps-nousussa/#0a7d2507 Ylivoimainen viime kuukausien nousija1353881Totuuspuolueen johtaja Jaana "prinsessa Leia" Kavonius on vangittu
Kavonius määrättiin jo keväällä 2024 poissaolevana vangittavaksi todennäköisin syin epäiltynä 13 vainoamisesta ja 24 kun4471848Kovia syytöksiä Stefan Thermaninsta.
Jättänyt taas maksamatta kohuliikemies, hupparit ja muita ostamiaan tavaroita. On soiteltu liikkeestä ja Stefan iskenyt1831829En minä kyllä enää odota sinua
Olet siellä sen harmaan kanssa. Niin, annoit minun nähdä lämpimät tunteesi siitä huolimatta. Se merkitsi kyllä paljon. O351736Jos joku luulee että kaikki käy
Sanon vain tämän. Minun kanssani ei neuvotella. Minun kanssani eletään tasavertaisesti. Jos se on liikaa, niin ovi rinn521385Joka kolmas työtön on työkyvytön
Viime vuonna työnhakuvelvoitteen ulkopuolella oli noin kolmannes työttömistä työnhakijoista. Huhheijaa, mihin suomalais1521221Sakin hivutus - ilmiö
Miten tuollainen tuollainen ilmiö kuin ”sakin hivutus” syntyy? Mitä syitä ilmiön syntymiseen tarvitaan? Onko sakissa jok661163Ei ole rohkeutta tulla jututtamaan
Voidaan me nähdä ja tervehtiä, sitäkin harvoin, mutta iso kynnys on edes mennä lähelle ja kysyä kuulumisia. Ymmärrät var81141