tableau à inverser

Bonjour
D'après Patrick

...
Je dois inverser/modifier un gros tableau suivant l'exemple dont le lien
est ci-dessous..
Peut on me donner un coup de main (sans formule mais par VBA tableau ou
dictionnaire)?
Un + serait de commenter les lignes :)
http://www.cjoint.com/c/FLjqcF8qIVx ...

rigolo comme problème :-)

voilà un exemple qui fonctionne sur ton tableau et il suffit de changer
quelques constantes pour que ça fonctionne sur un tableau plus grand

----------------------------------------
Sub inverser()
' attention c'est sensible à la casse et aux espaces
' utiliser au besoin trim et Lcase
' j'ai rajouté une colonne pour voir : la symétrie n'est pas nécessaire
' pour les dimensions du tableau
' mais l'unicité des valeurs par colonne est nécessaire dans le tableau
' de départ

Dim i0 As Integer, j0 As Integer, i1 As Integer, j1 As Integer
Dim verti, hori ' seront des tableaux je laisse en variant
' i0 et j0 emplacement du premier tableau
' i1 et j1 : emplacement du deuxième - ils sont sur la même feuille
i0 = 3: j0 = 1
i1 = 22: j1 = 1
' i1 doit être plus grand que 20 utilisé pour tester le nombre de
' colonnes plus bas
' ou alors j1 plus grand que 10 utilisé pour nombre de lignes

Set valsverti = CreateObject("Scripting.Dictionary")
' liste des noms horizontaux (verticaux tableau 2)
Set valshori = CreateObject("Scripting.Dictionary")
' liste des noms trouvés dans la 2ème colonne (horizontaux tableau 2)
For j = 1 To Cells(3, 10).End(xlToLeft).Column - j0
' si moins de 10 colonnes en tout - ou remplacer par nombre de colonnes
' le test sur l'existence évite l'erreur à la valeur vide
' le test sur l'existence évite l'erreur à la valeur vide
If Not valsverti.exists(Cells(i0, j + j0).Value) Then
' mais il risque de laisser un trou si doublons
valsverti.Add Cells(i0, j + j0).Value, j
End If
Next

For i = 1 To Cells(20, 1).End(xlUp).Row - i0
' si moins de 20 lignes en tout - ou remplacer par nombre de lignes
' le test sur l'existence évite l'erreur à la valeur vide
If Not valshori.exists(Cells(i + i0, j0 + 1).Value) Then
' mais il risque de laisser un trou si doublons
valshori.Add Cells(i + i0, j0 + 1).Value, i
' liste des nom trouvés dans la deuxième colonne (horizontaux tableau
2)
End If
Next

verti = valsverti.keys
' liste des noms horizontaux (verticaux tableau 2)
' verti(i) donne le ième nom
hori = valshori.keys
' liste des nom trouvés dans la 2ème colonne (horizontaux tableau 2)

For i = 0 To valsverti.Count - 1
Cells(valsverti(verti(i)) + i1, j0).Value = verti(i)
Next
For j = 0 To valshori.Count - 1
Cells(i1, valshori(hori(j)) + j0).Value = hori(j)
Next

For i = 1 To valshori.Count
For j = 1 To valsverti.Count
'en parcourant le tableau du haut
' cells(i+i0,j+j0).value donne valshori son rang est
' valshori(cells(i+i0,j+j0).value) auquel j'ajouterai j0
' cells(i+i0,j0).value me donne valsvals et je l'écrirai en bas
' cells (i0, j+j0).value me donne valsverti son rang est
' valsverti(cells(i0,j+j0).value auquel j'ajouterai i1

Cells(valsverti(Cells(i0, j + j0).Value) + i1, valshori(Cells(i + i0, j
+ j0).Value) + j0).Value = Cells(i + i0, j0).Value

Next
Next

End Sub

-------------------------------
cdlt

--
-

Bonjour
D'après Patrick

...
Je dois inverser/modifier un gros tableau suivant l'exemple dont le
lien est ci-dessous..
Peut on me donner un coup de main (sans formule mais par VBA tableau ou
dictionnaire)?
Un + serait de commenter les lignes
http://www.cjoint.com/c/FLjqcF8qIVx ...

rigolo comme problème

voilà un exemple qui fonctionne sur ton tableau et il suffit de changer
quelques constantes pour que ça fonctionne sur un tableau plus grand

----------------------------------------
Sub inverser()
' attention c'est sensible à la casse et aux espaces
' utiliser au besoin trim et Lcase
' j'ai rajouté une colonne pour voir : la symétrie n'est pas nécessaire
' pour les dimensions du tableau
' mais l'unicité des valeurs par colonne est nécessaire dans le tableau
de départ

Dim i0 As Integer, j0 As Integer, i1 As Integer, j1 As Integer
Dim verti, hori ' seront des tableaux je laisse en variant
' i0 et j0 emplacement du premier tableau
' i1 et j1 : emplacement du deuxième - ils sont sur la même feuille
i0 = 3: j0 = 1
i1 = 22: j1 = 4
' i1 doit être plus grand que 20 utilisé pour tester le nombre de
' colonnes plus bas
' ou alors j1 plus grand que 10 utilisé pour nombre de lignes

Set valsverti = CreateObject("Scripting.Dictionary")
' liste des noms horizontaux (verticaux tableau 2)
Set valshori = CreateObject("Scripting.Dictionary")
' liste des noms trouvés dans la 2ème colonne (horizontaux tableau 2)
For j = 1 To Cells(3, 10).End(xlToLeft).Column - j0
' si moins de 10 colonnes en tout - ou remplacer par nombre de colonnes
' le test sur l'existence évite l'erreur à la valeur vide
' mais il risque de laisser un trou si doublons
If Not valsverti.exists(Cells(i0, j + j0).Value) Then
valsverti.Add Cells(i0, j + j0).Value, j
End If
Next

For i = 1 To Cells(20, 1).End(xlUp).Row - i0
' si moins de 20 lignes en tout - ou remplacer par nombre de lignes
' le test sur l'existence évite l'erreur à la valeur vide
' mais il risque de laisser un trou si doublons
If Not valshori.exists(Cells(i + i0, j0 + 1).Value) Then
valshori.Add Cells(i + i0, j0 + 1).Value, i
End If
Next

verti = valsverti.keys
' liste des noms horizontaux (verticaux tableau 2)
' verti(i) donne le ième nom
hori = valshori.keys
' liste des nom trouvés dans la 2ème colonne (horizontaux tableau 2)

Cells(valsverti(verti(i)) + i1, j1).Value = verti(i)
Next
For j = 0 To valshori.Count - 1
Cells(i1, valshori(hori(j)) + j1).Value = hori(j)
Next

For i = 1 To valshori.Count
For j = 1 To valsverti.Count
'en parcourant le tableau du haut
' cells(i+i0,j+j0).value donne valshori son rang est
' valshori(cells(i+i0,j+j0).value) auquel j'ajouterai j1
' cells(i+i0,j0).value me donne valsvals et je l'écrirai en bas
' cells (i0, j+j0).value me donne valsverti son rang est
' valsverti(cells(i0,j+j0).value auquel j'ajouterai i1

Cells(valsverti(Cells(i0, j + j0).Value) + i1, valshori(Cells(i +
i0, j + j0).Value) + j1).Value _
= Cells(i + i0, j0).Value

Next
Next

End Sub
-------------------------------
cdlt

--
-

hello
D'après Patrick

Bonjour,

Je dois inverser/modifier un gros tableau suivant l'exemple dont le lien est
ci-dessous..
http://www.cjoint.com/c/FLjqcF8qIVx

variante : cette fois on met le résultat sur une autre feuille
c'est mieux je trouve si letableau est gros

-----------------
Sub inverser(f1 As String, f2 As String)
'f1 feuille de départ, f2 feuille arrivée
' attention c'est sensible à la casse et aux espaces
' utiliser au besoin trim et Lcase
' j'ai rajouté une colonne pour voir : la symétrie n'est pas nécessaire
' pour les dimensions du tableau
' mais l'unicité des valeurs par colonne est nécessaire dans le tableau
de départ

Dim i0 As Integer, j0 As Integer, i1 As Integer, j1 As Integer
Dim verti, hori ' seront des tableaux je laisse en variant
' i0 et j0 emplacement du premier tableau sur f1
' i1 et j1 : emplacement du deuxième sur f2
i0 = 3: j0 = 1
i1 = 3: j1 = 1
' pas de problème si f1 et f2 sont différents sinon attention au
recouvrement
With Sheets(f1)
Set valsverti = CreateObject("Scripting.Dictionary")
' liste des noms horizontaux (verticaux tableau 2)
Set valshori = CreateObject("Scripting.Dictionary")
' liste des noms trouvés dans la 2ème colonne (horizontaux tableau 2)
For j = 1 To .Cells(3, 100).End(xlToLeft).Column - j0
' si moins de 100 colonnes en tout - ou remplacer par nombre de
colonnes
' le test sur l'existence évite l'erreur à la valeur vide
' mais il risque de laisser un trou si doublons
If Not valsverti.exists(.Cells(i0, j + j0).Value) Then
valsverti.Add .Cells(i0, j + j0).Value, j
End If
Next

For i = 1 To .Cells(200, 1).End(xlUp).Row - i0
' si moins de 200 lignes en tout - ou remplacer par nombre de lignes
' le test sur l'existence évite l'erreur à la valeur vide
' mais il risque de laisser un trou si doublons
If Not valshori.exists(.Cells(i + i0, j0 + 1).Value) Then
valshori.Add .Cells(i + i0, j0 + 1).Value, i
End If
Next

verti = valsverti.keys
' liste des noms horizontaux (verticaux tableau 2)
' verti(i) donne le ième nom
hori = valshori.keys
' liste des nom trouvés dans la 2ème colonne (horizontaux tableau 2)

For i = 0 To valsverti.Count - 1
Sheets(f2).Cells(valsverti(verti(i)) + i1, j1).Value = verti(i)
Next
For j = 0 To valshori.Count - 1
Sheets(f2).Cells(i1, valshori(hori(j)) + j1).Value = hori(j)
Next

For i = 1 To valshori.Count
For j = 1 To valsverti.Count
'en parcourant le tableau du haut
' cells(i+i0,j+j0).value donne valshori son rang est
' valshori(cells(i+i0,j+j0).value) auquel j'ajouterai j1
' cells(i+i0,j0).value me donne valsvals et je l'écrirai en bas
' cells (i0, j+j0).value me donne valsverti son rang est
' valsverti(cells(i0,j+j0).value auquel j'ajouterai i1

Sheets(f2).Cells(valsverti(.Cells(i0, j + j0).Value) + i1,
valshori(.Cells(i + i0, j + j0).Value) + j1).Value _
= .Cells(i + i0, j0).Value

Next
Next
End With
End Sub

Sub test()
Call inverser("avant", "apres")
End Sub
-------------

cdlt

--
-

Le vendredi 9 décembre 2016 17:06:03 UTC+1, Patrick a écrit  :

Bonjour,

Bonjour,

merci, je regarde ça dans la semaine :)

Patrick

Je dois inverser/modifier un gros tableau suivant l'exemple dont le lien
est ci-dessous..

Peut on me donner un coup de main (sans formule mais par VBA tableau ou
dictionnaire)?

Un + serait de commenter les lignes :)

Merci

http://www.cjoint.com/c/FLjqcF8qIVx

bonjour Patrick,

mon exemple suppose que le tableau est sur la Feuil1 et commence à la cellule A1
le résultat est mit sur la Feuil2

Sub Test_inverser_tableau()
Dim Dico1 As New Scripting.Dictionary
Dim Dico2 As New Scripting.Dictionary
Dim c As Range
Dim lign1 As Long, coln1 As Integer
Dim lign2 As Long, coln2 As Integer

Set f1 = Sheets("Feuil1")
Set f2 = Sheets("Feuil2")
f2.Range("A:F").ClearContents

' grandeur du tableau original
With f1
lign1 = .Cells(.Rows.Count, 1).End(xlUp).Row
coln1 = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set plg = .Range(.Cells(2, 2), .Cells(lign1, coln1))
End With

' ajout de la Clé1(10, 20, 30....) (sans doublon)dans le Dico1
For i = 2 To coln1
Cle1 = f1.Cells(1, i)
If Not Dico1.Exists(Cle1) Then Dico1.Add Cle1, i
Next
'transpose le dico1 (10, 20, 30....) dans la "Feuil2"
f2.Range("A2").Resize(Dico1.Count, 1) = Application.Transpose(Dico1.Keys)


' ajout de la Clé2(G01, G02, G03....) (sans doublon)dans le Dico2
For Each c In plg
If Not Dico2.Exists(c.Value) Then Dico2.Add c.Value, i
Next
'transpose le dico1 (G01, G02, G03....) dans la "Feuil2"
f2.Range("B1").Resize(1, Dico2.Count) =
Application.Transpose(Application.Transpose(Dico2.Keys))

' inscrire les noms
For Each c In plg
n1 = f1.Cells(1, c.Column) ' (10, 20, 30....)
n2 = f1.Cells(c.Row, 1) ' (Pierre, Paul....)
lign2 = Application.Match(n1, f1.Rows(1), 0) 'ligne de f2
coln2 = Application.Match(c, f2.Rows(1), 0) 'colonne de f2
f2.Cells(lign2, coln2) = n2
Next

Set Dico1 = Nothing
Set Dico2 = Nothing
End Sub

isabelle

Le 2016-12-09 à 11:06, Patrick a écrit :

Bonjour,

Je dois inverser/modifier un gros tableau suivant l'exemple dont le lien est
ci-dessous..

Peut on me donner un coup de main (sans formule mais par VBA tableau ou
dictionnaire)?

Un + serait de commenter les lignes :)

Merci

http://www.cjoint.com/c/FLjqcF8qIVx

un peu plus court avec une boucle en moins,

Sub Test_inverser_tableau2()
Dim Dico1 As New Scripting.Dictionary
Dim Dico2 As New Scripting.Dictionary
Dim c As Range
Dim lign1 As Long, coln1 As Integer
Dim lign2 As Long, coln2 As Integer
Dim i As Integer

Set f1 = Sheets("Feuil1")
Set f2 = Sheets("Feuil2")
f2.Range("A:F").ClearContents

' grandeur du tableau original
With f1
lign1 = .Cells(.Rows.Count, 1).End(xlUp).Row
coln1 = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set plg = .Range(.Cells(2, 2), .Cells(lign1, coln1))
End With

' ajout de la Clé1(10, 20, 30....) (sans doublon)dans le Dico1
For i = 2 To coln1
Cle1 = f1.Cells(1, i)
If Not Dico1.Exists(Cle1) Then Dico1.Add Cle1, i
Next
'transpose le dico1 (10, 20, 30....) dans la "Feuil2"
f2.Range("A2").Resize(Dico1.Count, 1) = Application.Transpose(Dico1.Keys)


' ajout de la Clé2(G01, G02, G03....) (sans doublon)dans le Dico2
For Each c In plg
If Not Dico2.Exists(c.Value) Then Dico2.Add c.Value, i
'transpose le dico1 (G01, G02, G03....) dans la "Feuil2"
f2.Range("B1").Resize(1, Dico2.Count) =
Application.Transpose(Application.Transpose(Dico2.Keys))
'inscrire les noms
n1 = f1.Cells(1, c.Column) ' (10, 20, 30....)
n2 = f1.Cells(c.Row, 1) ' (Pierre, Paul....)
lign2 = Application.Match(n1, f1.Rows(1), 0) 'ligne de f2
coln2 = Application.Match(c, f2.Rows(1), 0) 'colonne de f2
f2.Cells(lign2, coln2) = n2
Next

Set Dico1 = Nothing
Set Dico2 = Nothing
End Sub

isabelle

une autre plus rapide... en une seul boucle
http://www.cjoint.com/c/FLmbD51INxa

Sub Test_inverser_tableau1()
Dim Dico1 As New Scripting.Dictionary, Dico2 As New Scripting.Dictionary
Dim lign1 As Long, coln1 As Integer, lign2 As Long, coln2 As Integer
Dim c As Range, i As Integer

Set f1 = Sheets("Feuil1")
Set f2 = Sheets("Feuil2")

f2.Cells.ClearContents

lign1 = f1.Cells(Rows.Count, 1).End(xlUp).Row
coln1 = f1.Cells(1, Columns.Count).End(xlToLeft).Column
Set plg = f1.Range(Cells(2, 2).Address, Cells(lign1, coln1).Address) 'tableau
original

For Each c In plg
If Not Dico1.Exists(c.Row) Then Dico1.Add c.Row, f1.Cells(1, c.Row) 'ajout
sur dico1(10, 20, 30....)
If Not Dico2.Exists(c.Value) Then Dico2.Add c.Value, 1 'ajout
sur dico2(G01, G02, G03....)
f2.Range("B1").Resize(1, Dico2.Count) =
Application.Transpose(Application.Transpose(Dico2.Keys))
lign2 = Application.Match(f1.Cells(1, c.Column), f1.Rows(1), 0) 'ligne de
f2 (10, 20, 30....)
coln2 = Application.Match(c, f2.Rows(1), 0) 'colonne
de f2 (G01, G02, G03....)
f2.Cells(lign2, coln2) = f1.Cells(c.Row, 1) ' inscrire les noms(Pierre,
Paul....)
Next

f2.Range("A2").Resize(Dico1.Count, 1) = Application.Transpose(Dico1.Items)
'copie de(10, 20, 30....)

Set Dico1 = Nothing
Set Dico2 = Nothing
End Sub


isabelle

Bonjour Isabelle,

merci, j'étais arrivé au 2/3 de la solution et je ne trouvais pas de solution avec les lignes application.match !

Super !
Il me reste à adapter parce que il peut y avoir 2 noms dans un mê me groupe, mais je pense avoir réussi :)

ps:
Je tente de mettre ça dans un tableau et puis coller le tableau au lie u d'écrire par une boucle dans les cellules...
J'ignore comment déclarer, redimensionner ce tableau (malgré les exemples trouvés) et le coller en 2e ligne, 2e colonne de la feuille c ible (f2)

Si tu as 5 minutes :)

Patrick

ps: Ce tableau risque de servir quelques fois ! Génial !


Le vendredi 9 décembre 2016 17:06:03 UTC+1, Patrick a écrit  :

Bonjour,

Je dois inverser/modifier un gros tableau suivant l'exemple dont le lien
est ci-dessous..

Peut on me donner un coup de main (sans formule mais par VBA tableau ou
dictionnaire)?

Un + serait de commenter les lignes :)

Merci

http://www.cjoint.com/c/FLjqcF8qIVx

tu pourrais remplacer la ligne

f2.Cells(lign2, coln2) = f1.Cells(c.Row, 1)
par
f2.Cells(lign2, coln2) = f2.Cells(lign2, coln2) & " - " & f1.Cells(c.Row, 1)

isabelle

Le 2016-12-12 à 01:12, PatrIck a écrit :

Super !
Il me reste à adapter parce que il peut y avoir 2 noms dans un même groupe, mais je pense avoir réussi :)

Le vendredi 9 décembre 2016 17:06:03 UTC+1, Patrick a écrit  :

Bonjour,

Je dois inverser/modifier un gros tableau suivant l'exemple dont le lien
est ci-dessous..

Peut on me donner un coup de main (sans formule mais par VBA tableau ou
dictionnaire)?

Un + serait de commenter les lignes :)

Merci

http://www.cjoint.com/c/FLjqcF8qIVx

Merci Isabelle !