XL 2010 Reprise du fil transposition

[bobafric]

Bonjour
Comment modifier le code de transposition pour que lors de l'opération on supprime les lignes A2 A3 A5 A6 A8 A9 ETC
Merci

 

[sylvanu]

Bonjour Bobafric,
J'ai modifié la structure pour être infiniment plus rapide, dans le cas de grandes listes. Code modifié :

Sub Transposition()
    Dim DL%, L%
    On Error GoTo Fin
    Application.ScreenUpdating = False
    DL = Range("A65500").End(xlUp).Row      ' Dernière ligne
    tablo = Range("A1:A" & DL)              ' Données dans tableau
    Range("A1:C" & DL).ClearContents        ' Effacement plage
    ReDim tablo2(1 + Int(DL / 3), 2)        ' Dimension tableau de sortie
    For L = 1 To DL Step 3
        Indice = (L - 1) / 3                ' Calcul indice tableau de sortie
        tablo2(Indice, 0) = tablo(L, 1)     ' 1ere valeur dans 1ere colonne
        tablo2(Indice, 1) = tablo(L + 1, 1) ' 2eme valeur dans 2eme colonne
        tablo2(Indice, 2) = tablo(L + 2, 1) ' 3eme valeur dans 3eme colonne
    Next L
    [A1].Resize(1 + UBound(tablo2, 1), 1 + UBound(tablo2, 2)) = tablo2 ' Restitution tableau de sortie
    Exit Sub
Fin:
    MsgBox "Les données ne semblent pas avoir le bon format attendu."
End Sub

( Le second bouton sert uniquement à rapatrier des données pour faire le test )[/Code]

 

[bobafric]

Bonjour Bobafric,
J'ai modifié la structure pour être infiniment plus rapide, dans le cas de grandes listes. Code modifié :

Sub Transposition()
    Dim DL%, L%
    On Error GoTo Fin
    Application.ScreenUpdating = False
    DL = Range("A65500").End(xlUp).Row      ' Dernière ligne
    tablo = Range("A1:A" & DL)              ' Données dans tableau
    Range("A1:C" & DL).ClearContents        ' Effacement plage
    ReDim tablo2(1 + Int(DL / 3), 2)        ' Dimension tableau de sortie
    For L = 1 To DL Step 3
        Indice = (L - 1) / 3                ' Calcul indice tableau de sortie
        tablo2(Indice, 0) = tablo(L, 1)     ' 1ere valeur dans 1ere colonne
        tablo2(Indice, 1) = tablo(L + 1, 1) ' 2eme valeur dans 2eme colonne
        tablo2(Indice, 2) = tablo(L + 2, 1) ' 3eme valeur dans 3eme colonne
    Next L
    [A1].Resize(1 + UBound(tablo2, 1), 1 + UBound(tablo2, 2)) = tablo2 ' Restitution tableau de sortie
    Exit Sub
Fin:
    MsgBox "Les données ne semblent pas avoir le bon format attendu."
End Sub

( Le second bouton sert uniquement à rapatrier des données pour faire le test )[/Code]

Merci Sylvanu tu es un véritable pro
A bientôt