VBA - Fusion sans doublon

Bonjour,

J'ai un petit souci de listing je pense. suivant une feuille, j'essaye de ramener plusieurs valeurs dans un seul tableau du style suivant un même code item. (voir sample ça sera plus simpe)

Table 1:

Door 57,5

Mirror 6,75

Cabinet Door 2,75

Table 2:

Door 76

Mirror 8

Cabinet Door 4

Table 3:

Door 18,5

Mirror 1,25

Cabinet Door 1,25

Résultat actuel:

Door 57,5 / 76 / 18,5

Mirror

Cabinet Door

Résultat attendu:

Door 57,5 / 76 / 18,5

Mirror 6,75 / 8 / 1,25

Cabinet Door 2,75 / 4 / 1,25

Le problème, c'est que le listing sans doublon se fait bien, mais le fait de ramener les valeurs sur la même ligne du code item ne marche que sur la première ligne et non les restes. Je pense avoir un petit souci de propagation, sauf que là je bloque un peu....

Sub compil()
  Dim suite As Range
  Dim i&, k&, mondico, temp
  Dim Colonne1 As Range, Colonne2 As Range, Colonne3 As Range

    With Sheets("Matrice")
        Set Colonne1 = Sheets("Matrice").Range(("A2"), Sheets("Matrice").Range("A2").End(xlDown))
        Set Colonne2 = Sheets("Matrice").Range(("D2"), Sheets("Matrice").Range("D2").End(xlDown))
        Set Colonne3 = Sheets("Matrice").Range(("G2"), Sheets("Matrice").Range("G2").End(xlDown))
        Set suite = Sheets("Perfo").[A65536].End(xlUp).Offset(1, 0)
        i = .Cells(65535, 1).End(xlUp).Row
        If i > 1 Then
        Set mondico = CreateObject("Scripting.Dictionary")
        For k = 2 To i
            temp = .Cells(k, 1)
            mondico(temp) = mondico(temp) + 1
        Next
            suite.Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
            suite.Offset(0, 1).Formula = "=VLOOKUP(" & suite.Address & ",'" & Colonne1.Parent.Name & "'!" & Colonne1.Resize(, 2).Address & ",2,FALSE)"
            suite.Offset(0, 2).Formula = "=VLOOKUP(" & suite.Address & ",'" & Colonne2.Parent.Name & "'!" & Colonne2.Resize(, 2).Address & ",2,FALSE)"
            suite.Offset(0, 3).Formula = "=VLOOKUP(" & suite.Address & ",'" & Colonne3.Parent.Name & "'!" & Colonne3.Resize(, 2).Address & ",2,FALSE)"
        End If
    End With
End Sub

Merci d'avance pour votre aide,

Bonjour,

le vba est il obligatoire ? (utile si beaucoup de lignes)

ça peut se faire par formule (sur base de ton exemple )

P.

ou alors:

Option Explicit ' doit être dans un module et pas lthisworkbook !!!

Sub compiler()
Dim suite As Range
Dim i&, k&, mondico, temp
Dim Colonne1 As Range, Colonne2 As Range, Colonne3 As Range
Dim X, C
Dim F1, F2 As Worksheet
Set F1 = Sheets("matrice"): Set F2 = Sheets("perfo")
With Sheets("Matrice")
   Set Colonne1 = Sheets("Matrice").Range(("A2"), Sheets("Matrice").Range("A2").End(xlDown))
   Set Colonne2 = Sheets("Matrice").Range(("D2"), Sheets("Matrice").Range("D2").End(xlDown))
   Set Colonne3 = Sheets("Matrice").Range(("G2"), Sheets("Matrice").Range("G2").End(xlDown))
   Set suite = Sheets("Perfo").[A65536].End(xlUp).Offset(1, 0)
   i = .Cells(65535, 1).End(xlUp).Row
   If i > 1 Then
      Set mondico = CreateObject("Scripting.Dictionary")
      For k = 2 To i
         temp = .Cells(k, 1)
         mondico(temp) = mondico(temp) + 1
      Next
      suite.Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
      suite.Offset(0, 1).Formula = "=VLOOKUP(" & suite.Address(0, 1) & ",'" & Colonne1.Parent.Name & "'!" & Colonne1.Resize(, 2).Address & ",2,FALSE)"
      suite.Offset(0, 2).Formula = "=VLOOKUP(" & suite.Address(0, 1) & ",'" & Colonne2.Parent.Name & "'!" & Colonne2.Resize(, 2).Address & ",2,FALSE)"
      suite.Offset(0, 3).Formula = "=VLOOKUP(" & suite.Address(0, 1) & ",'" & Colonne3.Parent.Name & "'!" & Colonne3.Resize(, 2).Address & ",2,FALSE)"
   End If
End With
X = F2.[A65000].End(xlUp).Row
F2.Range("B2:D" & X).FillDown
End Sub

Bonjour Patrick,

Merci de ton aide, Oui si je passe par le VBA c'est pour un traitement avec un nombre de ligne qui peut varier entre 0 et une centaine de ligne bon pas plus de mile ça c'est sur ^^

nunos31 a écrit :

Bonjour Patrick,

Merci de ton aide, Oui si je passe par le VBA c'est pour un traitement avec un nombre de ligne qui peut varier entre 0 et une centaine de ligne bon pas plus de mile ça c'est sur ^^

J'ai modifié mon post...

Merci Patrick,

C'est parfait, Merci beaucoup de ton aide