XL 2010 Reprise du fil transposition

bobafric

XLDnaute Occasionnel
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
 

Pièces jointes

  • TRANSPOSITION.xlsm
    16 KB · Affichages: 4
Solution
Bonjour Bobafric,
J'ai modifié la structure pour être infiniment plus rapide, dans le cas de grandes listes. Code modifié :
VB:
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...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Bobafric,
J'ai modifié la structure pour être infiniment plus rapide, dans le cas de grandes listes. Code modifié :
VB:
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]
 

Pièces jointes

  • TRANSPOSITION (1).xlsm
    19.3 KB · Affichages: 1

bobafric

XLDnaute Occasionnel
Bonjour Bobafric,
J'ai modifié la structure pour être infiniment plus rapide, dans le cas de grandes listes. Code modifié :
VB:
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
 

Statistiques des forums

Discussions
299 952
Messages
1 980 342
Membres
207 062
dernier inscrit
K2OPA