XL 2013 Transformation tableau en deux colonnes

kingfadhel

XLDnaute Impliqué
Bon après-midi aux Xlds,
Je viens vers vous une autre fois pour résoudre un problème,
J'ai un tableau qui contient des données de cartes numérotées déployées dans plusieurs régions et je souhaite pouvoir les transformer en deux colonnes.
Capture.PNG


Classeur joint.
Merci
 

Pièces jointes

  • king2.xlsx
    10.3 KB · Affichages: 4
Solution
Bonjour Kingfadhel, Fanfan,
Un essai en PJ avec :
VB:
Sub Compte()
    Dim T0, DL&, L&, i&: T0 = Timer
    [I:J].ClearContents: [I3] = "N° de carte": [J3] = "Région"
    Application.ScreenUpdating = False
    DL = [A1000000].End(xlUp).Row
    ReDim T(1 To Cells(DL, "C"), 1 To 2)
    For L = 4 To DL
        Premier = Cells(L, "B"): Dernier = Cells(L, "C"): Region = Cells(L, "A")
        For i = Premier To Dernier
            T(i, 1) = i: T(i, 2) = Region
        Next i
    Next L
    [I4].Resize(UBound(T, 1), UBound(T, 2)) = T
    [I1] = "Temps éxécution : " & Round(Timer - T0, 3) & " s"
End Sub

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Kingfadhel, Fanfan,
Un essai en PJ avec :
VB:
Sub Compte()
    Dim T0, DL&, L&, i&: T0 = Timer
    [I:J].ClearContents: [I3] = "N° de carte": [J3] = "Région"
    Application.ScreenUpdating = False
    DL = [A1000000].End(xlUp).Row
    ReDim T(1 To Cells(DL, "C"), 1 To 2)
    For L = 4 To DL
        Premier = Cells(L, "B"): Dernier = Cells(L, "C"): Region = Cells(L, "A")
        For i = Premier To Dernier
            T(i, 1) = i: T(i, 2) = Region
        Next i
    Next L
    [I4].Resize(UBound(T, 1), UBound(T, 2)) = T
    [I1] = "Temps éxécution : " & Round(Timer - T0, 3) & " s"
End Sub
 

Pièces jointes

  • king2.xlsm
    16 KB · Affichages: 3

kingfadhel

XLDnaute Impliqué
Bonjour Kingfadhel, Fanfan,
Un essai en PJ avec :
VB:
Sub Compte()
    Dim T0, DL&, L&, i&: T0 = Timer
    [I:J].ClearContents: [I3] = "N° de carte": [J3] = "Région"
    Application.ScreenUpdating = False
    DL = [A1000000].End(xlUp).Row
    ReDim T(1 To Cells(DL, "C"), 1 To 2)
    For L = 4 To DL
        Premier = Cells(L, "B"): Dernier = Cells(L, "C"): Region = Cells(L, "A")
        For i = Premier To Dernier
            T(i, 1) = i: T(i, 2) = Region
        Next i
    Next L
    [I4].Resize(UBound(T, 1), UBound(T, 2)) = T
    [I1] = "Temps éxécution : " & Round(Timer - T0, 3) & " s"
End Sub
@sylvanu, c'est extraordinaire, génial.
SVP, commentez le code si possible.
 

Discussions similaires

Réponses
7
Affichages
293

Statistiques des forums

Discussions
312 215
Messages
2 086 329
Membres
103 184
dernier inscrit
Di Martino