Inserire progressivo

[robi88_na]

Salve a tutti. Non so se è un problema già presentato ma è molto particolare, faccio direttamente l'esempio altrimenti non saprei come spiegarlo.

Ho un foglio composto da 3 colonne che sono ID, Codice e Numero locali, ad ogni ID possono essere associati diversi Codici con il relativo Numero locali, quindi ho una struttura di questo tipo ad esempio
ID_Codice__ N°Locali
1____1______2
1____2______5
1____4______3
2____1______1
2____7______4
3____5______3
... ... ...
Quello che io vorrei fare è creare un nuovo foglio in cui ho sempre la stesa struttura, ma una nuova colonna al posto di N°locali, in cui c'è il progressivo dei locali, cioè (riferendosi all'esempio):
ID Codice Progressivo_Locale
1 1 1
1 1 2
1 2 1
1 2 2
1 2 3
1 2 4
1 2 5
1 4 1
1 4 2
1 4 3
2 1 1
2 7 1
2 7 2
2 7 3
2 7 4
3 5 1
3 5 2
3 5 3

Esiste un modo veloce, una formula, ecc. per fare ciò? (ovviamente non posso farlo a mano, ho circa 40000 righe)

Spero di essermi spiegato bene, ringrazio anticipatamente per le risposte

[ricky53]

Ciao Rob,
prova questo esempio

Codice: Seleziona tutto

Option Explicit

Sub Elabora()
    Dim UR As Long, I As Long, J As Long, K As Long, X As Long, WS1 As Worksheet, WS2 As Worksheet
   
    Set WS1 = Sheets("Foglio1") ' <<===== QUI devi scrivere il nome del tuo foglio sul quale sono i dati
    Set WS2 = Sheets("Foglio2") ' <<===== QUI devi scrivere il nome del tuo foglio sul quale scrivere i dati elaborati
   
    UR = WS2.Range("A" & Rows.Count).End(xlUp).Row
    If UR > 1 Then
        WS2.Range("A2:C" & UR).ClearContents ' <<===== Cancella i dati esitenti sul "Foglio 2" colonne "A-C"
    End If
   
    UR = WS1.Range("A" & Rows.Count).End(xlUp).Row
    X = 2
    For I = 2 To UR
        For J = 1 To WS1.Cells(I, "C")
            WS2.Cells(X, "A") = WS1.Cells(I, "A")
            WS2.Cells(X, "B") = WS1.Cells(I, "B")
            WS2.Cells(X, "C") = J
            X = X + 1
        Next J
    Next I
   
    Set WS1 = Nothing
    Set WS2 = Nothing
   
    MsgBox "Elaborazione effettuata", vbInformation
End Sub

Il codice è commentato.
Ho ipotizzato che i dati inizino dalla riga "2" del Foglio 1.
I dati vengono scritti a partire dalla riga "2" del Foglio 2.

Prova e se hai dei dubbi sai dove trovarmi.