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

383

Ää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. Jos venäjällä olisi kansan valitsema presidentti, olisiko Ukrainan sotaa?

      Ei varmasti olisi. Sehän on tiedossa, että raskaalla vaalivilpillä putin jatkaa pressana.
      Maailman menoa
      300
      4082

    2. Riikka jytkytti naftan hinnan jo yli 2,3 euroon

      Sannan aikaan esimerkiksi dieseliä selvästi kalliimpaa bensaakin sai 1,3 eurolla. https://www.is.fi/autot/art-200001188
      Maailman menoa
      110
      3699

    3. Päivän Sanna: Suomi maailman onnellisin maa

      Sanna muutti Suomen maailman onnellisimmaksi maaksi. Hänen pyyteetön työnsä maailmalla tuottaa edelleen tulosta.
      Maailman menoa
      53
      2736

    4. Vasemmiston feministinaiset puolustavat islamia

      mikä on täysin järjenvastaista, mutta eihän femakoilla paljon järkeä olekkaan, leijuvat siellä omassa kuplassaan. Myös
      Maailman menoa
      207
      2736

    5. Ei se halua mitään!!

      Arkailija koko tyyppi!
      Ikävä
      62
      2375

    6. Jätän tähän viesti kaivatullesi

      jos jotain jäänyt sanomatta. 👇
      Ikävä
      154
      1962

    7. Olet kyllä erittäin huono yhdistelemään pisteitä.

      Etkä vain sinä vaan kaikki teilläpäin.
      Ikävä
      34
      1747

    8. Etkö sitten itse

      ole koskaan ylittänyt rajaa?
      Ikävä
      43
      1383

    9. Onko jo liian "vanha" vai mitä mieltä olet? 57-v. saa raakaa tekstiä tv:ssä

      The Summit Suomi tv-ohjelmassa 57-vuotiaan Maritan jaksamista kyseenalaistettiin iän takia. Onko tässä iässä jo liian "v
      50 plus
      35
      1368

    10. Mitä järkeä iskeä

      Varattua ja yrittää saada sitä eroamaan
      Ikävä
      46
      1252
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt