Suppression doublons dans colonnes sous conditions

[lefrizey]

Re-bonjour,

A chaque changement de NOM dans colonne A, Je souhaite comparer chaque valeur numérique de la colonne B à chaque valeur de la colonne C. Dès que ces valeur sont égales, je supprime les lignes des doublons.
Je passe au prochain NOM.

J'ai joins un fichier pour expliquer.

 

[phlaurent55]

Re : Suppression doublons dans colonnes sous conditions

Boonjour lefrizey,

https://www.excel-downloads.com/thr...et-suppression-lignes-sous-conditions.223115/

À+
Phiippe

 

[pierrejean]

Re : Suppression doublons dans colonnes sous conditions

Bonjour lefrizey

Vois si cela te convient

Edit Salut Phillipe

 

[phlaurent55]

Re : Suppression doublons dans colonnes sous conditions

Ou encore ici,


https://www.excel-downloads.com/threads/supprime-lignes-vides-sous-3-conditions.222836/

 

[Lolote83]

Re : Suppression doublons dans colonnes sous conditions

Salut à tous,
Le temps de concevoir ma réflexion et déjà PhLaurent55 et PierreJean sont passés par là.
Pour ne pas avoir réfléchi pour rien je poste tout de même
Cordialement
Lolote83

 

[lefrizey]

Re : Suppression doublons dans colonnes sous conditions

Bonjour Pierrejean,
C'est tout simplement super!Je t'en remercie grandement!

 

[lefrizey]

Re : Suppression doublons dans colonnes sous conditions

Bonjour Lolote83,
Je te rassure que tu n'as pas réfléchi pour rien. Le code que tu me proposes répond parfaitement à ma préoccupation.
Merci beaucoup.

 

[lefrizey]

Re : Suppression doublons dans colonnes sous conditions

Phlaurent55 Bonjour,

Je reconnais le lien que tu m'invites à visiter. J'avais mal formulé le pb, et du coup je ne pense pas avoir été compris. Comme c'était important, j'ai posté la présente discussion avec un langage moins touffus et surtout plus correct.
merci d'avoir réagi en ma faveur.

 

[pierrejean]

Re : Suppression doublons dans colonnes sous conditions

Re

Suite MP voici la macro modifiée pour le cas ou plusieurs doublons de la colonne A se trouveraient en colonne B

Sub test()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
x = Range("B" & Rows.Count).End(xlUp).Row
xx = Range("C" & Rows.Count).End(xlUp).Row
If x > xx Then
  derlintab = x
Else
  derlintab = xx
End If
ReDim tab_nom(0)
For n = 2 To derlintab
  If Range("A" & n) <> "" Then
    tab_nom(UBound(tab_nom)) = n
    ReDim Preserve tab_nom(UBound(tab_nom) + 1)
  End If
Next
For n = LBound(tab_nom) To UBound(tab_nom) - 1
If n <> UBound(tab_nom) - 1 Then
 fin = tab_nom(n + 1)
Else
 fin = derlintab + 1
End If
  Set jour = Range("B" & tab_nom(n) + 1 & ":B" & fin - 1)
  Set nuit = Range("C" & tab_nom(n) + 1 & ":C" & fin - 1)
  For Each cel In jour
    For Each cel1 In nuit
      If cel.Value <> 0 And cel1.Value <> 0 And cel.Value <> "" And cel1.Value <> "" And cel.Value = cel1.Value And cel.Interior.ColorIndex = xlNone And cel1.Interior.ColorIndex = xlNone Then
        cel.Interior.ColorIndex = 3
        cel1.Interior.ColorIndex = 3
      End If
    Next
  Next
Next
For n = derlintab To 1 Step -1
  If Range("B" & n).Interior.ColorIndex = 3 Then Rows(n).Delete
  If Range("C" & n).Interior.ColorIndex = 3 Then Rows(n).Delete
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[lefrizey]

Re : Suppression doublons dans colonnes sous conditions

C'est effectivement cela. En ajoutant [ cel.Interior.ColorIndex = xlNone ] dans le bloc "For each" ça marche.
C'est parfait. Que dis-tu pour les commandes de réduction du temps d'exécution??

 

[lefrizey]

Re : Suppression doublons dans colonnes sous conditions

C'est effectivement cela. En ajoutant [ cel.Interior.ColorIndex = xlNone ] dans le bloc "For each" ça marche.
C'est parfait. Que dis-tu pour les commandes de réduction du temps d'exécution??

 

[pierrejean]

Re : Suppression doublons dans colonnes sous conditions

Re

Pour la reduction du temps ,je te proposes ceci (tout traité par tableaux)

Sub test1()
Dim zone As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
x = Range("B" & Rows.Count).End(xlUp).Row
xx = Range("C" & Rows.Count).End(xlUp).Row
If x > xx Then
  derlintab = x
Else
  derlintab = xx
End If
ReDim tab_nom(0)
For n = 2 To derlintab
  If Range("A" & n) <> "" Then
    tab_nom(UBound(tab_nom)) = n
    ReDim Preserve tab_nom(UBound(tab_nom) + 1)
  End If
Next
ReDim tabres(0)
For n = LBound(tab_nom) To UBound(tab_nom) - 1
 If n <> UBound(tab_nom) - 1 Then
   fin = tab_nom(n + 1)
  Else
   fin = derlintab + 1
 End If
 jour = Range("B" & tab_nom(n) + 1 & ":B" & fin - 1)
 nuit = Range("C" & tab_nom(n) + 1 & ":C" & fin - 1)


 For m = LBound(jour, 1) To UBound(jour, 1)
  For p = LBound(nuit, 1) To UBound(nuit, 1)
   If jour(m, 1) <> "" And nuit(p, 1) <> "" And jour(m, 1) <> 0 And nuit(p, 1) <> 0 And jour(m, 1) = nuit(p, 1) Then
     nuit(p, 1) = ""
     jour(m, 1) = ""
     tabres(UBound(tabres)) = tab_nom(n) + m
     ReDim Preserve tabres(UBound(tabres) + 1)
     tabres(UBound(tabres)) = tab_nom(n) + p
     ReDim Preserve tabres(UBound(tabres) + 1)
   End If
  Next
 Next
Next
For n = LBound(tabres) To UBound(tabres) - 1
  If zone Is Nothing Then
    Set zone = Rows(tabres(n))
  Else
    Set zone = Application.Union(zone, Rows(tabres(n)))
  End If
Next
zone.Delete
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub