Discussion :

[goldfinger13]

bonsoir à tout le monde,
je vous sollicite car depuis plusieurs jours je tourne en rond. Je voudrais comparer par macro chaque cellule de la colonne D avec toutes celles de cette même colonne. Si je trouve une valeur identique alors concatener les deux lignes de la colonne E en colonne F.
je ne sais pas si c'est assez explicite je joins un fichier exemple.
merci d'avance pour votre aide.

[casefayere]

Pour ce que j'ai compris, à aménager, code dans un module :

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
Option Explicit
Public derlg As Long
Sub Test_doublons()
With ActiveSheet
   derlg = .Range("a" & .Rows.Count).End(xlUp).Row
   IdentifieDoublons
End With
End Sub
 
Sub IdentifieDoublons()
Dim Un As Collection, x As Long
Set Un = New Collection
On Error Resume Next
With ActiveSheet
   For x = 1 To derlg
      If Range("D" & x) <> "" Then
         Un.Add Range("D" & x), CStr(Range("D" & x))
         If Err <> 0 Then
            .Range("F" & x) = .Range("E" & x - 1) & " - " & .Range("E" & x)
            .Range("A" & x - 1).EntireRow.Delete 'les lignes en double sont supprimées
            x = x - 1
         End If
            'Efface toutes les valeurs de l'objet Err.
         Err.Clear
      End If
 
   Next x
End With
Set Un = Nothing
End Sub

[Docmarti]

Si j'ai bien compris ce que tu attends comme résultat:

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
Sub t()
derlig = 9
Dim deux As New Collection
 For i = 1 To derlig
 ok = False
     deux.Add Cells(i, 5).Value, Cells(i, 5).Value
  For j = 1 To derlig
   If j <> i Then
    If Cells(j, 4).Value = Cells(i, 4).Value Then
     On Error Resume Next
      deux.Add Cells(j, 5).Value, Cells(j, 5).Value
     ok = True
    End If
   End If
  Next
  If ok = True Then
  Concatenation = ""
  For k = 1 To deux.Count
   Concatenation = Concatenation & " " & deux.Item(k)
  Next
  Cells(i, 6).Value = Concatenation
  End If
  Set deux = Nothing
 Next
End Sub

[goldfinger13]

Bonsoir le forum et bonsoir et merci à casefayere et docmarti pour votre aide.
C'est la solution proposée par doctmarti qui correspond le mieux à ce que je cherche comme résultat. Il faut maintenant que j'arrive a comprendre le code pour poursuivre. au cas ou je vous re sollicite.
encore merci pour votre aide