Kopiointia

pom

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

7

380

Äänestä

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • kunde

      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.

      • kunde

        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
        @Kunde

        Vaan eipä näytä toimivan ollenkaan Long tyypillä.

      • kunde
        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ä.

    Takaisin ylös

    Luetuimmat keskustelut

    1. Lääppijä Lindtman jäi kiinni itse teosta

      Lindtman kyselemättä ja epäasiallisesti koskettelee viestintäpäällikköä. https://www.is.fi/politiikka/art-2000011780852
      Maailman menoa
      170
      3906

    2. Huomaatteko Demari Tytti ei esitä pahoitteluitaan

      Samanlainen ilmeisesti kuin Marin eli Uhriutuu no he ovat Demareita ja muiden yläpuolella siis omasta mielestään
      Maailman menoa
      81
      3109

    3. Turvaan tulleet lähettävät omia lapsiaan vaaraan - hullua

      MOT-ohjelman jakso ”Loma vaihtui kahleisiin” kertoi, kuinka Suomessa ja muualla Euroopassa asuvat somaliperheet lähettäv
      Maailman menoa
      46
      2143

    4. Vedonlyöntiä .

      Olen valmis lyömään ison vedon , että homma kaatuu . Jos kerta Sivonen ei lähde mukaan , niin ei tuoho usko kukaan muuka
      Ähtäri
      23
      2093

    5. Mikä on pahinta, mitä kaivatullesi

      pelkäät tapahtuvan? Jos kuolemaa, vakavia sairauksia yms. ei lasketa?
      Ikävä
      55
      1925

    6. TUNNISTELAATIKKO

      Tähän ketjuun voi laittaa yhdellä tai kahdella lauseella (tai vaikka yhdellä sanalla) täydellisen tunnisteen, jonka vain
      Ikävä
      85
      1341

    7. Minkä tunteen tunnet

      juuri nyt? ap kiitollisuuden.
      Tunteet
      40
      1270

    8. Tykkäätkö enemmän tavis- vai julkkiskisaajista tv:ssä?

      Tykkäätkö enemmän tavis- vai julkkiskisaajista tv:ssä? Moni reality ja visailuohjelma luottaa julkkiksiin, mutta sentään
      Tv-sarjat
      25
      1268

    9. Zoo jatkaa - jatkuuko mustamaalaus?

      Tänään on päätetty Zoon avaamisesta uudelleen. Mielenkiintoista nähdä kautokurujen reaktio, nyt kun kyse ei ole kunnalli
      Ähtäri
      58
      1048

    10. Valehdella saa, totuus salataan

      Vaikuttaa vähän siltä, että sensuuria toteutetaan juorupalstallakin. Asioita saa kaunistella ja vääristellä, mutta totuu
      Savonlinna
      10
      758
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt