XL 2010 Transformer un Tableau à double entrée en liste en VBA

[Bichette001]

Bonjour
j'ai un tableau avec 6 colonnes et en ligne des dates
je souhaiterai un code vba pour le transformer en liste
ex :
A B C D E
3/12/18 1 2 3 4 5
4/12/18 6 7 8 9 10

j'ai regardé le post du 21/2/13 mais je n'arrive pas à moduler pour fixer le nb de colonne qui ici est de 6

un grand merci pour votre aide

Bichette

 

[erics83]

Bonjour,

Une piste à explorer : les tutos de JB : http://boisgontierjacques.free.fr/
Je pense que dans l'index, tu trouveras la réponse ou une piste dans "Dictionary"

A+

 

[zebanx]

Bonjour Bichette, erics83, le forum

Avec un code de l'ami KLIN89

@+

 

[job75]

Bonjour Bichette001, erics83, zebanx,

A priori pas besoin de VBA, voyez le fichier joint et les formules très simples de la feuille "RES".

A+

 

[vgendron]

Hello tous !

avec ceci

Sub Tab1toTab2()
Dim tabInit() As Variant
Dim tabFinal() As Variant

With Sheets("Data")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    tabInit = .Range("A1:F" & fin).Value
    taille = (UBound(tabInit, 1) - 2) * UBound(tabInit, 2)
    ReDim tabFinal(1 To taille, 1 To 3)
    j = 1
    For i = 2 To UBound(tabInit, 1)
        For k = LBound(tabInit, 2) + 1 To UBound(tabInit, 2)
            tabFinal(j, 1) = tabInit(i, 1)
            tabFinal(j, 2) = tabInit(1, k)
            tabFinal(j, 3) = tabInit(i, k)
            j = j + 1
        Next k
       
    Next i
End With

With Sheets("RES")
    .UsedRange.Offset(1, 0).Clear
    .Range("A2").Resize(UBound(tabFinal, 1), UBound(tabFinal, 2)) = tabFinal
End With
End Sub

 

[Bichette001]

c'est génial !!!! vous êtes efficaces et rapides
Merci je vais progresser grâce à vous
bonne journée!
Bichette

 

[job75]

Re,

Si l'on tient absolument au VBA il suffit d'entrer les formules de mon post #4 :

Private Sub Worksheet_Activate()
Dim ncol%, h&
ncol = 5 'à adapter
ThisWorkbook.Names.Add "ncol", ncol 'nom défini
h = ncol * (Application.Max(Sheets("Data").[A:A]) - Application.Min(Sheets("Data").[A:A]) + 1)
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
Range("A2:C" & Rows.Count).ClearContents 'RAZ
[A2] = Application.Min(Sheets("Data").[A:A])
If h > 1 Then [A3].Resize(h - 1) = "=A2+NOT(MOD(ROW()-2,ncol))"
[B2].Resize(h) = "=INDEX(Data!$1:$1,2+MOD(ROW()-2,ncol))"
[C2].Resize(h) = "=IFERROR(INDEX(Data!A:IV,MATCH(A2,Data!A:A,0),2+MOD(ROW()-2,ncol)),"""")"
End Sub

La macro est à placer dans le code de la feuille, elle se déclenche quand on active la feuille.

Fichier joint.

A+

 

[Bichette001]

Bonjour Bichette001, erics83, zebanx,

A priori pas besoin de VBA, voyez le fichier joint et les formules très simples de la feuille "RES".

A+

Merci également pour ta solution qui sera pt-etre - lourde que du vba ?
petite question..
A quoi sert de mettre (MOD(LIGNE()-2;5) stp?
merci
Bichette

 

[ChTi160]

Bonjour Bichette001
Bonjour le Fil ,le Forum
histoire de vous saluer !
Bichette
pour ce qui est des formules pour ne pas les conserver tu ajoutes ce qui est en Gras à cet emplacement:

[C2].Resize(h) = "=IFERROR(INDEX(Data!A:IV,MATCH(A2,Data!A:A,0),2+MOD(ROW()-2,ncol)),"""")"
With [A2].Resize(h, 3)
.Value = .Value
End With
End Sub (/Quote]

jean marie

 

[Bichette001]

Re,

du coup je suis tentée de me dire qu'avec index equiv je px faire la même chose sur un multi entrée

est-ce possible d'après vous ?

 

[job75]

Merci également pour ta solution qui sera pt-etre - lourde que du vba ?

Le VBA n'est pas lourd et les macros proposées par zebanx et vgendron sont très rapides : 0,3 seconde chez moi avec 6000 dates en 1ère feuille.

L'intérêt de mes formules c'est qu'elles ne sont pas volatiles, elles se recalculent uniquement quand on modifie la 1ère feuille.

A quoi sert de mettre (MOD(LIGNE()-2;5) stp?

La fonction MOD crée une périodicité de 5 puisque c'est le nombre de types de flux.

 

[Bichette001]

Re,

Si l'on tient absolument au VBA il suffit d'entrer les formules de mon post #4 :

Private Sub Worksheet_Activate()
Dim ncol%, h&
ncol = 5 'à adapter
ThisWorkbook.Names.Add "ncol", ncol 'nom défini
h = ncol * (Application.Max(Sheets("Data").[A:A]) - Application.Min(Sheets("Data").[A:A]) + 1)
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
Range("A2:C" & Rows.Count).ClearContents 'RAZ
[A2] = Application.Min(Sheets("Data").[A:A])
If h > 1 Then [A3].Resize(h - 1) = "=A2+NOT(MOD(ROW()-2,ncol))"
[B2].Resize(h) = "=INDEX(Data!$1:$1,2+MOD(ROW()-2,ncol))"
[C2].Resize(h) = "=IFERROR(INDEX(Data!A:IV,MATCH(A2,Data!A:A,0),2+MOD(ROW()-2,ncol)),"""")"
End Sub

La macro est à placer dans le code de la feuille, elle se déclenche quand on active la feuille.

Fichier joint.

A+

Merci pour ce code , si j'ajoute des colonnes et /ou lignes dans mon data qu'est-ce que je modifie ds le code d'après toi ?

 

[Bichette001]

Hello tous !

avec ceci

Sub Tab1toTab2()
Dim tabInit() As Variant
Dim tabFinal() As Variant

With Sheets("Data")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    tabInit = .Range("A1:F" & fin).Value
    taille = (UBound(tabInit, 1) - 2) * UBound(tabInit, 2)
    ReDim tabFinal(1 To taille, 1 To 3)
    j = 1
    For i = 2 To UBound(tabInit, 1)
        For k = LBound(tabInit, 2) + 1 To UBound(tabInit, 2)
            tabFinal(j, 1) = tabInit(i, 1)
            tabFinal(j, 2) = tabInit(1, k)
            tabFinal(j, 3) = tabInit(i, k)
            j = j + 1
        Next k
      
    Next i
End With

With Sheets("RES")
    .UsedRange.Offset(1, 0).Clear
    .Range("A2").Resize(UBound(tabFinal, 1), UBound(tabFinal, 2)) = tabFinal
End With
End Sub

merci pour ce code, si par ex mon data va jusque col H qu'est-ce que je modifie dans le code d'après toi vgendron?merci...

 

[vgendron]

juste cette ligne
tabInit = .Range("A1:F" & fin).Value
qui devient
tabInit = .Range("A1:H" & fin).Value

 

[job75]

Merci pour ce code , si j'ajoute des colonnes et /ou lignes dans mon data qu'est-ce que je modifie ds le code d'après toi ?

Pour les lignes rien, pour les colonnes adapter ncol comme je l'ai indiqué.