Convertir un tableau de données en une seul colonne

Question

J'espère que vous allez bien ! Je vous demande de bien vouloir m'aidé à réaliser mon petit projet, il s'agit d'insérer un bouton renseigné par un code VBA qui réalise la tâche suivante: Convertir un tableau contenant des données chronologiques indexées par n années en lignes et par 12 mois ou 4 trimestres en colonnes ( comme l’illustre l'image ci-dessous ) Le tableau doit être converti en trois colonnes, la 1ère contenant: les années, la 2ème: le rang et la 3ème: les données en question. ( voir l'image ci-dessous ) * Pour bien comprendre mon souhait voici quelques indications: Le bouton ( ou code VBA ) doit: Demander quelle est la 1ère ligne du tableau à copier .................................... ( variable a ) Demander quelle est la 1ère colonne du tableau à copier ............................. ( variable b ) Demander quelle est la 1ère ligne du tableau à créer ...................................... ( variable c ) Demander quelle est la 1ère colonne du tableau à créer ............................... ( variable d ) Demander quel est le nombre d'années ................................................................ ( variable n ) Demander quel est le nombre de mois(12) ou trimestres(4) ......................... ( variable p ) Copier en colonne d les années écrire en colonne d+1 le rang t correspondent aux dates (i;j) t= 1, 2, ... np Copier en colonne d+2 les donnés Yt de la série. Merci d'avance...

Curulis · Accepted Answer

Salut mohin-stat,

peux-tu essayer ceci sur d'autres tableaux que ceux présentés dans le fichier?

Le tableau-réponse s'affiche 2 colonnes plus à droite que le tableau à traiter!

ATTENTION AUX DONNEES VOISINES!

Un double-clic sur la cellule "Années" du tableau-cible démarre la macro!

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
If InStr(Target, "Année") = 0 Then Exit Sub
Cancel = True
'
iRow = Target.Row
iCol = Target.Column
iRowE = Target.Offset(0, 1).End(xlDown).Row
iColE = Target.End(xlToRight).Column
'
iLig = iRow
Cells(iLig, iColE + 2) = "Années"
If iColE - iCol > 2 Then
    Cells(1, iColE + 4) = "Tot."
    For x = iRow + 1 To iRowE
        iIdx = 0
        Cells(iLig + 1, iColE + 2) = Cells(x, iCol)
        For y = iCol + 1 To iColE
            iIdx = iIdx + 1
            iLig = iLig + 1
            Cells(iLig, iColE + 3) = iIdx
            Cells(iLig, iColE + 4) = Cells(x, iCol + iIdx)
        Next
        If Cells(1, iColE + 3) = "" Then
            Select Case iIdx
                Case 24
                    Cells(1, iColE + 3) = "Bimens."
                Case 12
                    Cells(1, iColE + 3) = "Mens."
                Case 6
                    Cells(1, iColE + 3) = "Bimest."
                Case 4
                    Cells(1, iColE + 3) = "Trim."
                Case 3
                    Cells(1, iColE + 3) = "Quadri."
                Case 2
                    Cells(1, iColE + 3) = "Sem."
            End Select
        End If
    Next
Else
    iIdx = 25
    For x = iRow To iRowE
        If Cells(x, iCol + 1) < iIdx Then
            iIdx = 0
            iLig = iLig + 1
        End If
        iIdx = iIdx + 1
        If iIdx = 1 Then Cells(iLig, iColE + 2) = Cells(x, iCol)
        Cells(iLig, iColE + 2 + iIdx) = Cells(x, iCol + 2)
    Next
    If Cells(iRow, iColE + 3) = "" Then
        For x = 1 To iIdx
            Select Case iIdx
                Case 24
                    Cells(iRow, iColE + 2 + x) = Choose(x, "Janv ", "Janv ", "Févr ", "Févr ", "Mars ", "Mars ", "Avr ", "Avr ", "Mai ", "Mai ", "Juin ", "Juin ", _
                                    "Juil ", "Juil ", "Août ", "Août ", "Sept ", "Sept ", "Oct ", "Oct ", "Nov ", "Nov ", "Déc ", "Déc ") & _
                                        IIf(x Mod 2 = 0, 2, 1)
                Case 12
                    Cells(iRow, iColE + 2 + x) = Choose(x, "Janv-", "Févr-", "Mars-", "Avr-", "Mai-", "Juin-", "Juil-", "Août-", "Sept-", "Oct-", "Nov-", "Déc-")
                Case 6
                    Cells(iRow, iColE + 2 + x) = Choose(x, "Ja-Fé", "Ma-Av", "Ma-Ju", "Ju-Ao", "Se-Oc", "No-Dé")
                Case 4
                    Cells(iRow, iColE + 2 + x) = Choose(x, "J-F-M", "A-M-J", "J-A-S", "O-N-D")
                Case 3
                    Cells(iRow, iColE + 2 + x) = Choose(x, "J-F-M-A", "M-J-J-A", "S-O-N-D")
                Case 2
                    Cells(iRow, iColE + 2 + x) = Choose(x, "JFMAMJ", "JOSOND")
            End Select
        Next
    End If
End If
Range(Cells(iRow, iColE + 2), Cells(iLig, iColE + IIf(iColE - iCol > 2, 4, 2 + iIdx))).Borders.LineStyle = xlContinuous
'
End Sub

A+

14tabmohsin.xlsm (22.61 Ko)

Curulis · Answer

Salut mohsin-stat, peux-tu nous procurer tous les types de tableaux que tu comptes actualiser? Si il y a moyen de programmer cela plus efficacement... A+...

Curulis · Answer

Une première mouture : il suffit de sélectionner le tableau! A adapter en fonction d'autres types de tableaux! Private Sub Worksheet_SelectionChange(ByVal Target As Range) ' If Target.Count &gt; 1 Then iRow = Target.Row iCol = Target.Column iRowE = (Target.Rows.Count + iRow) - 1 iColE = (Target.Columns.Count + iCol) - 1 ' For x = iRow + 1 To iRowE iIdx = 0 Cells(iLig + 1, iColE + 2) = Cells(x, iCol) For y = iCol + 1 To iColE iIdx = iIdx + 1 iLig = iLig + 1 Cells(iLig, iColE + 3) = iIdx Cells(iLig, iColE + 4) = Cells(x, iCol + iIdx) Next Next End If ' End Sub A+...