Discussion :

[xavier.ledent]

Bonjour,

résoudre cette situation me paraissait simple jusqu'à ce que je bloque faute de résultats satisfaisant :

mon tableur contient en première colonne un numéro d'organisation (+-80). Ensuite, chaque colonne contient un numéro INS, il y a donc autant de colonnes que de numeros INS. En gros, le numùéro d'organisation est ma "clé primaire".

Pour des raisons de compatibilité avec un autre programme, je dois changer ma "clé primaire". Celle-ci devient le code INS pour lequel il peut y avoir plusieurs organisations.

Je suis persuadé que vous solutionnerez la situation facilement :-)

D'avance, merci pour votre contribution!!!

Xavier

[Jean-Philippe André]

Salut,

je ne comprends pas exactement ta question...

Peux-tu nous expliquer plus en details ta situation actuelle et celle que tu souhaiterais atteindre ?

[xavier.ledent]

Bonjour JP,

voici un exemple fictif de la situation de base (les fichiers sont au boulot) :

a : 1; 2;4;6;
b : 6;7;8;9
c : 1;6;8
d : 3;9;4
...
Ce que j'appelle clé primaire est donc a;b;c;d;... et les données associées sont les chiffres.

Je dois inverser ce classement pour faire des chiffres ma clé primaire et des lettres les données associées. Comme ceci :
1: a;b
2: a
3: d
4: a;d
5:
6: a;b;c
7:b
8:b;c
9:b;d

Est-ce plus clair ainsi?

MErci d'avance.

Xavier

[Jean-Philippe André]

OK

tu peux decomposer ton traitemenet en deux etapes :
1 / faire ressortir tous les binomes lettre/nombre
2 / concatener les lettres en face de chaque nombre

[casefayere]

Bonjour,
je me suis amusé par Vba à résoudre le problème, à tester si vous voulez, il y a certainement mieux, ci-dessous les codes à mettre dans "Feuil1" de l'éditeur
en haut de module (avant les sub)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Option Explicit
Dim i As Long, a As Long, TbF(), j As Long, TbG, Titre

une procédure pour le premier bouton

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub CommandButton1_Click()
inverse
End Sub

une procédure pour le deuxième bouton

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub CommandButton2_Click()
annuler
End Sub

La procédure principale

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub inverse()
Dim Dcel As Long, Dcol As Long, Dic As Object, c, Dpt As Range
  Dcel = Range("A2").End(xlDown).Row
  Dcol = Range("A2").End(xlToRight).Column
  ReDim TbF(1 To (Dcel - 1) * (Dcol - 1), 1 To Dcel - 1)
  Titre = Range("A2", Cells(2, Dcol))
  TbG = Range("A3", Cells(Dcel, Dcol))
  a = 0
  Set Dic = CreateObject("Scripting.Dictionary")
  For i = 2 To UBound(TbG, 2)
    For j = 1 To UBound(TbG, 1)
      a = a + 1
      TbF(a, 1) = TbG(j, i)
      If TbF(a, 1) <> "" Then Dic(TbF(a, 1)) = ""
    Next j
  Next i
  ReDim TbF(1 To Dic.Count, 1 To Dcel)
  a = 1
  For Each c In Dic
    TbF(a, 1) = c
    a = a + 1
  Next c
  tri (TbF)
  For i = 1 To UBound(TbF, 1)
   boucle TbF(i, 1)
  Next i
  On Error Resume Next
  Set Dpt = Application.InputBox("à partir de quelle cellule" & Chr(10) & "souhaitez-vous le résultat", "VOTRE ATENTION !", Type:=8)
  If Not Dpt Is Nothing Then
    If Dpt <> "" Then Dpt.CurrentRegion.Clear
    Dpt.Resize(UBound(TbF, 1), UBound(TbF, 2)) = TbF
  End If
  Error.Goto 0
End Sub

une fonction de tri

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Function tri(tableau) 'http://silkyroad.developpez.com/vba/tableaux/
Dim Cible As Variant
Do
  a = 0
    For i = 1 To UBound(tableau, 1) - 1
      If tableau(i, 1) > tableau(i + 1, 1) Then
        Cible = tableau(i, 1)
        tableau(i, 1) = tableau(i + 1, 1)
        tableau(i + 1, 1) = Cible
        a = 1
      End If
    Next i
Loop While a = 1
TbF = tableau
End Function

une boucle qui organise les données

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub boucle(x)
Dim z As Long
For z = 2 To UBound(TbG, 2)
  For j = 1 To UBound(TbG, 1)
    If TbG(j, z) = x Then
      For a = 2 To UBound(TbF, 2)
        If TbF(i, a) = "" Then
          TbF(i, a) = TbG(j, 1): Exit For
        End If
      Next a
    End If
  Next j
Next z
End Sub

et enfin si on veux annuler

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub annuler()
Dim VarTab As Variant
On Error Resume Next
VarTab = UBound(TbG)
On Error GoTo 0
If Not IsEmpty(VarTab) Then
  ActiveSheet.UsedRange.Clear
  Range("a2").Resize(1, UBound(Titre, 2)) = Titre
  Range("A3").Resize(UBound(TbG, 1), UBound(TbG, 2)) = TbG
End If
End Sub

le fichier en xlsx

[xavier.ledent]

Merci Dom,

Juste pour le fun, je testerai cela à mon retour au boulot ... en aout :-)
J'ai tiré mon plan avec la piste lancée par JP. Je n'avais pas pensé à cette création de binôme à trier puis à redécomposer.

Merci à tous. Sympa ce type de communauté qui aide les autres en relevant des petits défis.

Xavier

[casefayere]

alors bonnes vacances, et si tu veux du boulot pour tes congés, je t'envoie les codes avec les explications intégrées

[xavier.ledent]

Je veux bien les codes et explications, histoire que je sois un peu moins idiot ;-)

Super cool!!!

[casefayere]

ok, les codes ci-dessous et le fichier en xlsm
declarations variable pour le module entier

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Option Explicit
Dim i As Long, a As Long, TbF(), j As Long, TbG, Titre

1er bouton

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub CommandButton1_Click()
inverse
End Sub

2ème bouton

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Private Sub CommandButton2_Click()
annuler
End Sub

le programme principal

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub inverse()
Dim Dcel As Long, Dcol As Long, Dic As Object, c, Dpt As Range
  Dcel = Range("A2").End(xlDown).Row 'Dernière cellule non vide dans le tableau, non dans la feuille
  Dcol = Range("A2").End(xlToRight).Column 'Dernière colonne non vide dans le tableau, non dans la feuille
  ReDim TbF(1 To (Dcel - 1) * (Dcol - 1), 1 To Dcel - 1) ' je dimensionne la variable pour la remplir plus bas
  Titre = Range("A2", Cells(2, Dcol)) 'servira si annulation
  TbG = Range("A3", Cells(Dcel, Dcol)) 'tableau alimenté par la plage d'origine (sans les titres)
  a = 0
  Set Dic = CreateObject("Scripting.Dictionary") 'je déclare un dico
  For i = 2 To UBound(TbG, 2) 'je boucle sur le tableau (2ème dimension)
    For j = 1 To UBound(TbG, 1) 'je boucle sur le tableau (1ère dimension)
      a = a + 1
      TbF(a, 1) = TbG(j, i) 'j'alimente la 1ère dimension du tableau qui servira de résultat
      If TbF(a, 1) <> "" Then Dic(TbF(a, 1)) = "" 'et mon dico qui élimine les doublons et les vides
    Next j
  Next i
  ReDim TbF(1 To Dic.Count, 1 To Dcel) '2ème tableau redimensionné pour prendre les valeurs du dico
  a = 1
  For Each c In Dic 'une boucle qui prend les valeurs
    TbF(a, 1) = c
    a = a + 1
  Next c
  tri (TbF) 'j'atteins la procédure de tri
  For i = 1 To UBound(TbF, 1) 'je boucle pour organiser les données
   boucle TbF(i, 1)
  Next i
  'ci -dessous, c'est du brodage pour choisir la destination du résultat
  On Error Resume Next
  Set Dpt = Application.InputBox("à partir de quelle cellule" & Chr(10) & "souhaitez-vous le résultat", "VOTRE ATENTION !", Type:=8)
  If Not Dpt Is Nothing Then
    If Dpt <> "" Then Dpt.CurrentRegion.Clear 'on vide la région de la cellule choisie
    Dpt.Resize(UBound(TbF, 1), UBound(TbF, 2)) = TbF 'pour intégrer le résultat
  End If
  Error.Goto 0
End Sub

la fonction qui trie

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Function tri(tableau) 'je prends régulièrement cette méthode 'http://silkyroad.developpez.com/vba/tableaux/
Dim Cible As Variant
Do
  a = 0
    For i = 1 To UBound(tableau, 1) - 1
      If tableau(i, 1) > tableau(i + 1, 1) Then
        Cible = tableau(i, 1)
        tableau(i, 1) = tableau(i + 1, 1)
        tableau(i + 1, 1) = Cible
        a = 1
      End If
    Next i
Loop While a = 1
TbF = tableau
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub boucle(x) 'la boucle qui dispatche les données
Dim z As Long
For z = 2 To UBound(TbG, 2)
  For j = 1 To UBound(TbG, 1)
    If TbG(j, z) = x Then
      For a = 2 To UBound(TbF, 2)
        If TbF(i, a) = "" Then
          TbF(i, a) = TbG(j, 1): Exit For
        End If
      Next a
    End If
  Next j
Next z
End Sub

pour annuler

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub annuler() 'la commande qui ré-initialise les données (au cas ou...)
Dim VarTab As Variant
'ci-dessous, on vérifie que le tableau est alimenté
On Error Resume Next
VarTab = UBound(TbG)
On Error GoTo 0
'et on remet les données d'origine
If Not IsEmpty(VarTab) Then
  ActiveSheet.UsedRange.Clear
  Range("a2").Resize(1, UBound(Titre, 2)) = Titre
  Range("A3").Resize(UBound(TbG, 1), UBound(TbG, 2)) = TbG
End If
End Sub

et le fichier avec macros