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

356

Ää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. En voi jutella kanssasi

      tietenkään, mutta täällä voin sanoa sinulle, että se sinun hiljaisuutesi ja herkkyytesi eivät ole heikkoutta. Ne ovat ih
      Tunteet
      56
      7207

    2. Trump ja Vance murskasivat ja nolasivat Zelenskyn tiedotusvälineiden edessä Valkoisessa talossa.

      Jopa oli uskomaton tilaisuus Valkoisessa talossa. Zelensky jäi täydelliseksi lehdellä soittelijaksi suhteessa Trumpiin j
      Maailman menoa
      719
      3370

    3. Mikä on kaivattusi ärsyttävin piirre?

      Mun kaivattu on erittäin vastahakoinen puhumaan itsestä. Kääntää puheenaiheen aina muuhun kun hänestä tulee puhetta.
      Ikävä
      148
      1650

    4. Zelenskyi ei suostunut nöyrtymään Trumpin ja Vancen edessä, siksi meni pieleen

      Trumppia täytyy imarrella, silloin homma toimii aina. Tähän Zelenskyi ei suostunut.
      Maailman menoa
      278
      1530

    5. Koska olet rakastellut

      Kaivattusi kanssa viimeksi?
      Ikävä
      84
      1355

    6. Kokoomus haluaa hoitaa flussat yksityisellä, jotta säästettäisiin rahaa ja aikaa

      Mies hakeutui Terveystalo Kamppiin flunssaoireiden takia helmikuisena sunnuntai-iltana. Diagnoosiksi kirjattiin influens
      Maailman menoa
      84
      1351

    7. Miten saisin

      Sinut omakseni?
      Ikävä
      91
      1240

    8. Anteeksi Pekka -vedätys

      Apuna Ry:n somessa levinnyt Anteeksi Pakka -kampanja saa aina vaan kummallisempia piirteitä. ”Mä pyydän anteeksi. Mä
      Maailman menoa
      63
      1217

    9. Rakkaus ei iloitse vääryydestä vaan iloitsee yhdessä TOTUUDEN kanssa.

      Tajuatteko, että jotkut ihmiset pitävät siitä, kun toiset kaatuvat? He nauttivat siitä, kun toiset mokaavat tai käyttävä
      Idän uskonnot
      233
      1173

    10. Kumpi tästä

      Teidän tilanteesta teki vaikeaa? Sivusta
      Ikävä
      81
      1134
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt