Macro vba

Résolu
Bonjour,

Ceci est un problème relativement similaire à une question que j'ai posé hier. J'ai donc essayé de m'inspirer de l'aide que l'on m'a apporté hier mais en vain.

Col 1 Col 2

1 1
1 1
1 2
1 2
2 3
2 3
2 4
3 5
3 5
3 5
3 6
3 6

Je souhaiterai créer deux autres colonnes à partir de ces deux premières. La colonne 4 serait la colonne 2 mais sans doublon. Et je souhaiterai qu'en colonne 3 apparaisse les valeurs de la colonne 1 correspondant au valeur de la colonne 2. Pour plus de clarté le résultats de mon exemple serait comme ci dessous :

Col 3 Col4

1 1
1 2
2 3
2 4
3 5
3 6

Pouvez m'aider à la création d'une macro vba pour la réalisation de la colonne 3. (La colonne 4 n'étant qu'un simple comptage classique).

Sub moyenne_lot()
i = 1
Do While Cells(i, 2) <> ""
valeur = Cells(i, 1)
lot = Cells(i, 2)
Do While Cells(i + 1, 1) = valeur
lot = valeur
i = i + 1
Loop
Loop
End Sub

Voici ce que j'ai essayé de faire mais sans grand résultats.

Merci à vous.

Romain

4 réponses

  1. salut,

    "je souhaiterai qu'en colonne 3 apparaisse les valeurs de la colonne 1 correspondant au valeur de la colonne 2"

    qu'entends-tu par là ? j'ai du mal à voir...
    1. C'est vrai que c'est un problème assez dur à expliquer par écrit. Je vais essayer d'être plus précis.
      On considère que la colonne 4 est la même colonne 2 mais sans doublon (elle est donc forcément plus petite). La colonne 2 est associé à des chiffres de la colonne 1.
      Je souhaiterai que dans la colonne 3 les chiffres soient ceux de la colonne 1, qui étaient affecté à ceux de la colonne 2.

      Suis je assez clair? J'ai rédigé l'exemple pour que ce soit plus explicite mais s'il faut encore détailler certains point, je t'écoute.

      Merci

      Romain
      1. Contributeur
        Bonjour

        Sub apurer()  
        Dim derlig As Long, cptr As Long  
        Dim dico As Object  
        Dim ref1, ref2  
        Dim liste1, liste2  
        
        derlig = Cells(Cells.Rows.Count, 2).End(xlUp).Row  
        Set dico = CreateObject("scripting.dictionary")  
        For cptr = 1 To derlig  
             ref1 = Cells(cptr, 2)  
             ref2 = Cells(cptr, 1)  
             If Not dico.exists(ref1) Then  
                  dico.Add ref1, ref2  
             End If  
        Next  
        liste2 = dico.items  
        liste1 = dico.keys  
        
        
        Application.ScreenUpdating = False  
        Range("C1:D40000").Clear  
        Range("C1:C" & dico.Count) = Application.Transpose(liste2)  
        Range("D1:D" & dico.Count) = Application.Transpose(liste1)  
        End Sub  
        


        je ne connais pas le vrai type de ref1,ref2 donc...
        liste1 et liste2 doivent rester en variant

        mais peut-^tre pouvait on le faire + simplement avec des filtres (si j'ai le temps, je regarderais)
        Michel
        1. bravo michel_m, sacrée efficacité dans ton code !
          j'ai tenté une solution avec des boucles for mais beaucoup plus complexe que la tienne...
      2. Merci beaucoup Michel. Cela marche parfaitement bien. Je suis impressionné par la réactivité et la connaissance des membres de ce forum. Chapeau à vous !

        Encore merci !

        Romain