Recherche doublons puis conditions

Bonsoir tout le monde,

Je sollicite votre aide, j'ai une colonne B où des valeurs peuvent être en doublons. Je souhaiterai rechercher les doublons de la colonne B puis lorsque j'ai 2 valeurs identiques comparer la cellule de la colonne C (de la première ligne du doublon) avec la cellule E de la 2eme ligne du doublon.

Si ces 2 valeurs sont identiques en reporter une en colonne D, supprimer les valeurs C et E et supprimer une des 2 lignes du doublon.

Pour résumer par exemple dans le tableau allant de A1 à E47 je souhaite rechercher les valeurs en doublon de la colonne B (ex : B2 et B3), une fois trouver vérifier si C2 et E3 sont identiques et s'ils le sont alors je reporte cette valeur (C2 ou E3) en D2 ou D3, j'efface les valeurs en C2 ou E3 et je supprime soit la ligne 2 ou 3.

Si C2 et différent de E3 alors je ne touche à rien.

Le résultat désiré est représenté dans le tableau allant de A52 à E95.

Je ne sais pas si mon explication est compréhensible, s'il faut des formules ou du VBA mais je n'arrive pas à trouver de solutions.

Si des fois une âme charitable pouvait m'aider !!!

Merci.

13bus.xlsm (15.09 Ko)

Couac corrigé.

10bus.xlsm (22.34 Ko)
Option Explicit

Sub Doublons()
    Dim i As Long, j As Long, horaire As String

    For i = 2 To 47
        For j = 2 To 47
            If j <> i And Cells(i, 3) <> "" Then
                If Cells(i, 2) = Cells(j, 2) And Cells(i, 3) = Cells(j, 5) Then
                    Cells(j, 4) = Cells(i, 3)
                    Cells(j, 5) = ""
                    Rows(i).EntireRow.Delete
                End If
            End If
        Next j
    Next i
End Sub

Bonjour

Bonjour à tous

Un essai à tester. Te convient-il ?

10bus-v1.xlsm (32.53 Ko)
Option Explicit

Dim tablo, tabloR(), dico As Object
Dim i&, j&, k&, ln&

Sub SupprimerLesDoublons()

    tablo = Range("A1").CurrentRegion
    Set dico = CreateObject("Scripting.Dictionary")

    k = 0
    For i = 2 To UBound(tablo, 1)
        If Not dico.exists(tablo(i, 2)) Then
            ReDim Preserve tabloR(1 To 5, 1 To k + 1)
            For j = 1 To UBound(tablo, 2)
                tabloR(j, k + 1) = tablo(i, j)
            Next j
            dico(tablo(i, 2)) = k + 1
            k = k + 1
        Else
            ln = dico(tablo(i, 2))
            If tablo(i, 5) = tabloR(3, k) Then
                tabloR(4, k) = tabloR(3, k)
                tabloR(3, k) = ""
                tabloR(5, k) = ""
            End If
        End If
    Next i
    Range("G1").CurrentRegion.ClearContents
    Range("A1:E1").Copy Range("G1")
    Range("G2").Resize(UBound(tabloR, 2), 5) = Application.Transpose(tabloR)
End Sub

Bye !

Bonjour !

Une proposition Power Query :

21bus.xlsm (25.36 Ko)

Bonjour à tous les 3,

Merci pour vos réponses les 3 versions proposées fonctionnent parfaitement.

Optimix : ta version est la plus compréhensible pour moi vu mon niveau

gmb : mon fichier comporte à la base 11 colonnes allant de A à K. Je n'ai pas représenté les colonnes F à K (tout comme la colonne A la valeur restera toujours identique). Si je veux les ajouter à ta formule et afficher le résultat en colonne M ou mieux sur une nouvelle feuille comment puis-je faire?

JFL : je ne connais absolument pas power query mais vu le résultat je vais m'y intéresser (surtout que je vais bientôt utiliser power BI). Comment arrives-tu au résultat car je ne vois pas de macro?

Bonjour de nouveau !

Pour accéder à Power Query : Clic droit sur une cellule du tableau retourné par PQ : Analyse rapide / Table / Modifier la requête

L'éditeur PQ ouvert, les différents étapes conduisant au résultat final sont répertoriées à droite de l'écran (Etapes appliquées).

Nouvelle version.

36test-v2.xlsm (27.21 Ko)

Bye !

Merci à tous je marque ce sujet comme résolu

Rechercher des sujets similaires à "recherche doublons puis conditions"