Copiare righe n volte

Hai un problema con Excel?

Nuova discussione

Copiare righe n volte
di Dan (utente non iscritto) data: 08/10/2010
Ciao, sono un principiante totale in termini di macro e vorrei sapere se qualcuno mi può aiutare per risolvere il seguente problema:

data una matrice iniziale:
a b c
row1 abc def 3
row2 ghi lmn 2

devo copiare la matrice in un secondo foglio e poi devo copiare ogni riga tante volte quante indicate nella colonna c + riempire un'ulteriore casella (colonna d) concatenando i contenuti della colonna b e un contatore da 01 a n (con n equivalente al valore della colonna c)

in pratica, dalla matrice precedente il risultato da ottenere è il seguente:

a b c d
row1 abc def 3 def1
row2 abc def 3 def2
row3 abc def 3 def3
row4 ghi lmn 2 lmn1
row5 ghi lmn 2 lmn2

grazie mille davvero a chi mi possa aiutare!
dan

di Albatros54 (utente non iscritto) data: 09/10/2010
Vedi se ti va bene , fai sapere
ciao
albatros54

Public Sub albatros54()
    Dim sh4 As Worksheet
    Dim sh5 As Worksheet
    Dim lUltRiga As Long
    Dim count As Long
    Dim lng As Long
    Dim ln As Long
    Dim nm As Long
    Dim s1 As String
    Dim s2 As String
    
    With ThisWorkbook
        Set sh4 = .Worksheets("Foglio1")
        Set sh5 = .Worksheets("Foglio2")
    End With
    With sh4
        count = 1
        lUltRiga = .Range("A" & .Rows.count).End(xlUp).Row
        For lng = 1 To lUltRiga
        s1 = .Range("B" & lng)
        nm = .Range("B" & lng).Offset(0, 1)
        For ln = 1 To nm
        s2 = s1 & ln
        sh5.Cells(count, 1) = sh4.Cells(lng, 1)
        sh5.Range("b" & count) = sh4.Range("b" & lng)
        sh5.Range("B" & count).Offset(0, 2) = s2
        count = count + 1
        Next
        
       Next
         End With
        
End Sub

di Ricky53 (utente non iscritto) data: 09/10/2010
Ciao,

visto che mi ci trovavo ho scritto, in alternativa a quanto già inserito da albatros, una macro che ti potrebbe essere utile per risolvere la tua necessità.

attenzione:
la macro cancella tutti i dati del foglio2 (mediante l'istruzione "foglio2.cells.clearcontents") nel caso eliminala.

è volutamente scolastica ma comunque è ottimizzata.

ciao da ricky53

Option Explicit
Public UR As Long, I As Long, J As Long, K As Long, X As Long

Public Sub Ricky53()
    X = 1
    Foglio2.Cells.ClearContents
    UR = Foglio1.Range("A" & Rows.count).End(xlUp).Row
    For I = 1 To UR
        For J = 1 To Foglio1.Cells(I, 3)
            For K = 1 To 3
                Foglio2.Cells(X, K) = Foglio1.Cells(I, K)
            Next K
            Foglio2.Cells(X, 4) = Foglio1.Cells(I, 2) & J
            X = X + 1
        Next
    Next
End Sub

Vuoi Approfondire?