Recherche doublons et les mettre dans d' autre cellule

bonjour ,petit souci de tri

je souhaiterais retrouver les doublons et les mettre dans une autre cellule sans blanc par nom et par date

je vous envoie mon fichier pour mieux comprendre

merci a vous

bonjour

un essai

attention 3formules matricielles et distinctes

cordialement

re serait il possible de l'avoir en vba svp

merci pour votre interet

bonsoir ,j'ai essayer la formule a tulipe_4 mais cela ne me correspond pas

car je doit dans les colonnes A et B rajouter des textes

et qu'ils ce mettent directement dans les colonne correspondante

merci pour vos reponse

Bonsoir le fil, bonsoir le forum,

Une proposition VBA avec le code commenté ci-dessous :

Sub Macro1()
Dim O As Object 'déclare la variable O (Onglet)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim T1 As String 'déclare la variable T1 (donnée Temporaire 1)
Dim T2 As Integer 'déclare la variable T2 (donnée Temporaire 2)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim TT1 As Variant 'déclare la variable TT1 (Tableau Temporaire 1)
Dim TT2 As Variant 'déclare la variable TT2 (Tableau Temporaire 2)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim VB As Integer 'déclare la variable VB (Valeur en colonne B)

Set O = Sheets("Feuil1") 'définit l'onglet O
TC = O.Range("A3").CurrentRegion 'définit le tableau de cellules TC

'tri des données
For I = 1 To UBound(TC, 1) 'boucle 1 : sur toutes les lignes du tableau TC
    For J = 1 To UBound(TC, 1) 'boucle 2 : sur toutes les lignes du tableau TC
        'condition : si la valeur en colonne B de la boucle 1 est inférieure à la valeur de la colonne B de la boucle 2
        If TC(I, 2) < TC(J, 2) Then
            'la temporaire t1 prend la valeur de la colonne A de la boucle 1
            'la temporaire t2 prend la valeur de la colonne B de la boucle 1
            T1 = TC(I, 1): T2 = TC(I, 2)
            'la valeur en colonne A de la boucle 1 prend la valeur en colonne A de la boucle 2
            'la valeur en colonne B de la boucle 1 prend la valeur en colonne B de la boucle 2
            TC(I, 1) = TC(J, 1): TC(I, 2) = TC(J, 2)
            'la valeur en colonne A de la boucle 2 prend la valeur de la temporaire t1
            'la valeur en colonne B de la boucle 2 prend la valeur de la temporaire t2
            TC(J, 1) = T1: TC(J, 2) = T2
        End If 'fin de la condition
    Next J 'prochaine ligne de la boucle 2
Next I 'prochaine ligne de la boucle 1

'récupération des doublons
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnair D
For I = 1 To UBound(TC, 1) 'boucle sur toutes les lignes du tableau TC
    D(TC(I, 1)) = D(TC(I, 1)) + 1 'alimente le dictionnaire D
Next I 'prochaine ligne de la boucle
TT1 = D.keys 'récupère dans la tableau temporaire TT1 la liste des valeur en colonne A de TC sans doublon
TT2 = D.items 'récupère dans la tableau temporaire TT2 le nombre d'occurrence de chaque élément de la liste

'effacement des ancienne données
O.Range(O.Cells(1, 8), O.Cells(1, Application.Columns.Count)).EntireColumn.Clear

'renvoie des données dans l'onglet O
For I = 1 To UBound(TC, 1) 'boucle 1 sur toutes les lignes du tableau tc
    For J = 0 To UBound(TT1, 1) 'boucle 2 sur tous les éléments (sans doublon) du tableau tc
        If TT2(J) > 1 Then 'condition 1 : si le nombre de d'occurrence de l'élément est supérieur à 1
            If TC(I, 1) = TT1(J) Then 'condition 2 : si la valeur en colonne A de TC est égale à l'élément de TT1
                If TC(I, 2) = VB Then 'condition 3 : si la valeur de la colonne B de TC est égale à VB
                    Set DEST = DEST.Offset(1, 0) 'définit la cellule de destination DEST (la ligne en dessous)
                Else 'sinon
                    'définit la cellule de destination DEST (ligne 1 décalée de deux colonnes à droite)
                    Set DEST = IIf(O.Range("H1") = "", O.Range("H1"), O.Cells(1, Application.Columns.Count).End(xlToLeft).Offset(0, 2))
                End If 'fin de la condition 3
                DEST.Value = TC(I, 1) 'renvoie dans DEST la valeur en colonne A de TC
                DEST.Offset(0, 1).Value = TC(I, 2) 'renvoie dans DEST déclalée d'une colonne à droite la valeur en colonne B de TC
                VB = TC(I, 2) 'redéfinit la variable VB
            End If 'fin de la condition 2
        End If 'fin de la condition 1
    Next J 'prochain élément de la boucle 2
Next I 'prochaine ligne de la boucle 1
End Sub

Bonjour,

Voir fichier et procédure pour lister les doublons suivant 2 critères.

Cdlt.

Option Explicit
Private Sub cmdListeDoublons_Click()
Dim ws As Worksheet
Dim monDico1 As Object, monDico2 As Object
Dim rng As Range
Dim c As Variant
Dim tmp As String
Dim i As Long

    Application.ScreenUpdating = False
    Set ws = ActiveSheet

    With ws
        .Columns("D:E").Delete
        Set rng = .Range("A1").CurrentRegion
        Set monDico1 = CreateObject("Scripting.Dictionary")
        Set monDico2 = CreateObject("Scripting.Dictionary")
        For Each c In rng
            tmp = c & "|" & c.Offset(, 1)
            If monDico1.exists(tmp) Then monDico2.Item(tmp) = c.Row
            monDico1.Item(tmp) = ""
        Next c
        i = 1
        For Each c In monDico2.keys
            .Cells(i, 4) = .Cells(monDico2(c), 1)
            .Cells(i, 5) = .Cells(monDico2(c), 2)
            i = i + 1
        Next c
    End With

    Set c = Nothing
    Set monDico1 = Nothing: Set monDico2 = Nothing
    Set rng = Nothing
    Set ws = Nothing

End Sub

bonjour ,merci pour ta reponse mais je n'arrive pas a l'adapter a mon fichier "BOULE" pourrait tu me l'adapter stp

merci a toi

EXCUSEZ MOI mais je suis nul en VBA et jean -eric comment declancher ta macro car quand j'appuie sur le bouton rien ne se passe

merci encore je continue de chercher

Re,

Il faut activer les macros. Suis les explications de ce lien :

https://www.excel-pratique.com/fr/astuces_vba/activer_les_macros.php

Tu en profiteras pour ajouter le menu 'Développeur" dans le ruban.

Cdlt.

re,je suis désolé mais tout etait deja fait et le bouton ne fonctionne pas en passant dessus j'ai juste une croix mais pas de petite main

merci encore

Re,

J'ai vérifié le fonctionnement et c'est correct chez moi.

Le classeur a été téléchargé 8 fois, et il n'y a pas commentaires négatifs (mais?).

Le problème survient avec mon classeur, ou as-tu des soucis similaires avec d'autres classeurs avec des contrôles ActveX?

Peux-tu essayer d'insérer un nouveau contrôle CommandButton dans la feuille de calcul et me dire quel est son numéro?

Cdlt.

Bonjour,

Pas de nouvelles, bonnes nouvelles.

Cdlt