Calcul "fonction réciproque"

**Alpha2** · 06/11/2007, 22h33

Voilà mon problème :

J'ai deux séries de données, rangées dans deux colonnes.

La première est de ce type :
X1
X2
X3
...

La seconde est de ce type
Y1;Y4;Y43
Y3
Y2;Y8;Y4;Y5
...

En gros à chaque X corresponds un ensemble de Y's.

Il faut que j'arrive à construire la réciproque : une table des Y avec les X's correspondants.

Avec l'exemple ci-dessus, ma table d'entrée aurait cette aspect :
X1 Y1;Y4;Y43
X2 Y3
X3 Y2;Y8;Y4;Y5

Et en sortie je voudrais récupérer :
Y1 X1
Y2 X3
Y3 X2
Y4 X1;X3
Y5 X3
Y8 X3
Y43 X1

(enfin, pas forcément triée, l'ordre n'importe pas)

Comme je suis tout débutant en VBA, si qqn veut bien m'orienter, ce serait cool, je n'ai pas trouvé grand chose dans le forum (j'ai peut-être raté la chose par contre).

Merci.

PS: les "valeurs" X et Y sont des mots.

**Pierre Fauconnier** · 07/11/2007, 07h17

Bonjour. Bienvenue sur nos forums.

Voici une idée, par forcément optimisée. Il y a peut-être plus simple et/ou plus rapide (avec beaucoup de données)

L'idée consiste:
- à parcourir la plage des X de départ et à remplir un dictionnaire avec les Y trouvés à droite des X. Le dico refuse les doublons
- à transformer le contenu du dico en tableau
- à se positionner sur la première cellule de la plage de restitution, puis à itérer sur les y du tableau
- Pour chaque Y, à parcourir la plage des X et regarder si le Y se trouve dans la cellule de droite et si oui, à ajouter le X à droite de la cellule de la plage de restitution

Cela donne ceci

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
36
37
38
 
Sub Reciproque()
    Dim Cellule As Range
    Dim Tableau
    Dim Dico As Object
    Dim i As Integer
    Dim Plage As Range
    Dim CelluleArrivee As Range
 
    Set Dico = CreateObject("scripting.dictionary")
    Set Plage = Range("a1:a" & Range("a" & Rows.Count).End(xlUp).Row)
    Set CelluleArrivee = Range("d1")
 
    ' Remplissage du dictionnaire
    For Each Cellule In Plage
        Tableau = Split(Cellule(1, 2).Value, ";")
        For i = 0 To UBound(Tableau)
            If Not Dico.exists(Tableau(i)) Then Dico.Add Tableau(i), Tableau(i)
        Next i
    Next Cellule
 
    ' Conversion du dictionnaire en tableau
    Tableau = Dico.items
    ' Restitution des éléments du tableau
    For i = 0 To UBound(Tableau)
        CelluleArrivee.Value = Tableau(i) ' Remplissage avec Y
        CelluleArrivee(1, 2).ClearContents ' vidange de la cellule de droite
        For Each Cellule In Plage ' Itération sur la plage source
            ' Si Y présent dans la cellule de droite de la plage source, on ajoute le X
            If InStr(1, Cellule(1, 2).Value, Tableau(i)) <> 0 Then _
                CelluleArrivee(1, 2).Value = CelluleArrivee(1, 2).Value & ";" & Cellule.Value
        Next Cellule
        ' Nettoyage du premier ;
        CelluleArrivee(1, 2).Value = Right(CelluleArrivee(1, 2).Value, Len(CelluleArrivee(1, 2).Value) - 1)
        ' On descend d'une ligne pour le nouvel Y
        Set CelluleArrivee = CelluleArrivee(2)
    Next i
End Sub

Ok?