Discussion :

[Eleanor]

Bonjour à toutes et à tous,

Voilà j'ai cette fonction :

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
Sub compiler()
    Dim lig As Long, lig2 As Long, derlig As Long
    Application.ScreenUpdating = False
    [H:M].ClearContents
    [A:D].Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess
    lig2 = 1
    For lig = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(lig, 1) <> Cells(lig - 1, 1) Then
            If lig2 > 1 Then Cells(lig2, 10) = Left(Cells(lig2, 10), Len(Cells(lig2, 10)) - 3)
            lig2 = lig2 + 1
            Cells(lig, 1).Resize(1, 2).Copy Cells(lig2, 8)
        End If
        Cells(lig2, 10) = Cells(lig2, 10) & Cells(lig, 3) & " - "
    Next lig
    Application.ScreenUpdating = True
End Sub

qui me permet de recherche des doublons dans la première colonne (A), mais j'aimerai que cette fonction fasse la même chose pour la seconde colonne.
Exemple :

1        2
1        3
1        4
2        1
2        1

devrait m'afficher :

1        2
1        3
1        4
2        1

Merci d'avance pour votre aide

[Invité]

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 SupDoublon()
Dim CollectDoublon As New Collection
Dim RowsDel() As Long
Dim L As Long
Dim MyRange As Range
ReDim RowsDel(0)
Set MyRange = ActiveSheet.UsedRange
For L = 2 To MyRange.Rows.Count
MyRange(L, 3).Select
 MyRange(L, 6).Select
    Highlander (L & ";" & MyRange(L, 3).Value & ";" & MyRange(L, 6).Value), RowsDel, CollectDoublon
Next
For L = UBound(RowsDel) To 1
    ActiveSheet.Cells(CLng(RowsDel(L)), 1).EntireRow.Delete
Next
End Sub
Sub Highlander(Plage, RowsDel, CollectDoublon As Collection)
Dim I As Long
Dim T As String
Dim SplitPlage
SplitPlage = Split(Plage, ";")
On Error Resume Next
T = "T"
For I = 1 To UBound(SplitPlage)
 
      T = T & "_" & SplitPlage(I)
 
Next
CollectDoublon.Add T, T
If Err <> 0 Then
    ReDim Preserve RowsDel(UBound(RowsDel) + 1)
   RowsDel(UBound(RowsDel)) = SplitPlage(0)
End If
On Error GoTo 0
End Sub

[Eleanor]

Merci pour ton aide, malheureusement je ne sais pas quoi mettre dans les paramètres. Pour le premier je mets ma première colonne, et après Rowsdel je sèche.

[Invité]

Je pense avoir mal interprété ta demande!
ma fonction supprime les doublons sur 1, 2, ou autant de colonne que tu veux.
mais c'est pas exactement ce que tu veux.

[Eleanor]

Non pas exactement désolé. Je sais pas après, c'est peut-être moi qui me suis mal exprimée sur le sujet

[Invité]

Bonjour,
ton post n'est pas ambiguë, c'est ma tête qui a fait un raccourci. il y a des sujet récurrent et l'amalgame est vite fait!

[Eleanor]

Ah très bien. Personnellement j'ai regardé si quelqu'un avait fait ce que je souhaitais ou presque mais sans succès

[Patrice740]

Bonjour,

Essaies en remplaçant :

Code :

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

        If Cells(lig, 1) <> Cells(lig - 1, 1) Then

par :

Code :

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

        If Cells(lig, 1) & Cells(lig, 2) <> Cells(lig - 1, 1) & Cells(lig - 1, 2) Then

Cordialement
Patrice

[casefayere]

Bonjour,
si j'ai compris et avec ton exemple, testes ce fichier :

bonne journée