Supression des doubles suivant condition

Version imprimable

19/02/2008, 22h25
jawed

Supression des doubles suivant condition

:salut: a toutes et a tous
ma question est bref et j'espaire etre le plus claire possible dans ce tableau ci joint peut on suprimer tous les clients qui ont le meme phone s'il a dans User Status la montion Normal ,Pause ou Atack Locked
cordialement ;)
A bientot
22/02/2008, 21h40
jawed
Code:

1 2 ouisansdoute a dit Essaye avec les filtres élaborés dont tu copieras le résultat sur une nouvelle feuille
Voila une option interéssante dans excel que je ne connaissais pas. :merci: ouisansdoute ,mais cette derniere ne me suprime pas les clients de la Base mais elle me les archive dans une autre Feuille.
Alors peut-on suprimer les Phones de la Feuille1 s'ils existent dans la Feuille2 ???
Ci-joint fichier Excel
Cordialement ;)

Bonsoir jawed
trouvé dans le site de frederic.sigonneau
chercher les doublons dans une colonne et cacher les lignes en double
on cache toutes les lignes "doublons" en une seule passe à adapter

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub CacheLignesIdentiques()
Dim cell As Range, CellsToHide As Range, derLi As Long
 
  Application.ScreenUpdating = False
  derLi = Cells(Rows.Count, 7).End(xlUp).Row
  For i = derLi To 2 Step -1
    If Not IsError(Application.Match(Cells(i, 7).Value, _
                    Range("G1:G" & i - 1), 0)) Then
      If CellsToHide Is Nothing Then
        Set CellsToHide = Cells(i, 7)
      Else: Set CellsToHide = Union(CellsToHide, Cells(i, 7))
      End If
    End If
  Next i
   If Not CellsToHide Is Nothing Then _
      CellsToHide.EntireRow.Hidden = True
  End Sub

Bonne soirée
Abed_H de TIARET :king:

23/02/2008, 07h06
jawed

Salut a tous
Bonjour Abed_H
Merci pour le Code il m'aide certe,mais il cache tous les doublons de la feuille1 alors que moi je veut si c'est possible qu'il cache -de la feuille1-seulement les clients qui figure dans la feuille2
Nb:peut-on remplacé dans le code VBA Hide par Delete??
Cordialement ;)
23/02/2008, 12h39
Abed_H

Citation:

> Nb:peut-on remplacé dans le code VBA Hide par Delete??

Bonjour jawed
bien sûr que oui
Hide > cache les lignes
Delete > supprime les lignes
Bonne journée.
Abed_H
23/02/2008, 16h02
jawed

salut
je teste et je te rend compte
a bientot
cordialement ;)

boujour tous le monde
Abed_H j'ai changé le code par celui ci
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Sub CacheLignesIdentiques() Dim cell As Range, CellsToDelete As Range, derLi As Long Application.ScreenUpdating = False derLi = Cells(Rows.Count, 7).End(xlUp).Row For i = derLi To 2 Step -1 If Not IsError(Application.Match(Cells(i, 7).Value, _ Range("G1:G" & i - 1), 0)) Then If CellsToDelete Is Nothing Then Set CellsToDelete = Cells(i, 7) Else: Set CellsToDelete = Union(CellsToDelete, Cells(i, 7)) End If End If Next i If Not CellsToDelete Is Nothing Then _ CellsToDelete.EntireRow.Delete = True End Sub
il m'afiche un messge : Objet requis ensuite il me suprime tous les clients en double de la feuille 1 mais cela ne me resoud pas mon probleme car ce code ce contente seulement de suprimer que les doublons mais moi je veut si c'est possible suprimé tous le client de la feuille 1 si ce dernier existe dans la feuille 2 "voir le 2° fichier Excel ci-joint".
a bientot
cordialement ;)

24/02/2008, 20h00
Abed_H

Bonjour jawed
Mais ou est le 2° fichier je ne vois pas le lien ?
:nono:
pour ce qui est du message d'erreur remplace

Code:

CellsToDelete.EntireRow.Delete = True

par

Code:

CellsToDelete.EntireRow.Delete
24/02/2008, 21h54
jawed

salut Abed_H
tous dabord merci pour la solution du Code VBA.
en ce qui concerne le fichier dont je parlais il est dans le 2° message de ce poste tu peut le telecharger pour mieux me comprendre
a bientot
cordialemnt ;)

Bonsoir jawed
essaie ce code peut être que tu trouvera ton bonheur, j'ai légerement modifié

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub SuppD()
Dim cell As Range, CellDelete As Range, plage As Range
Set plage = Sheets("Feuil1").Range("G2:" & Sheets("Feuil1").Cells( _
            Rows.Count, 7).End(xlUp).Address)
 For Each cell In Range("G2:G" & Cells(Rows.Count, 7).End(xlUp).Row)
    If Not IsError(Application.Match(cell, plage, 0)) Then
       If cell.Offset(, -3) = "Pause" Or cell.Offset(, -3) = "normal" Or _
          cell.Offset(, -3) = "Attak locked" Then
               If CellDelete Is Nothing Then
                  Set CellDelete = cell
              Else: Set CellDelete = Union(CellDelete, cell)
          End If
    End If
   End If
 Next
        If Not CellDelete Is Nothing Then _
               CellDelete.EntireRow.Delete
End Sub

Abed_H ;)

25/02/2008, 06h37
jawed

Bonjour Abed_H
encors merci pour le code
effectivement Abed_H la premiere fois j'ai posté en se basant sur la colone User Status mais apres l'intervention de ouisansdoute j'ai preferé maitenant que le code vba se base sur la colone Phone
la condition: Si le meme n° de telephone existe dans dans la feuille1 et la feuille2 en suprime ce client de la feuille1
mes salutation a nas TIARET :D
cordialement ;)
nb:voici le fichier dont je parlais

salut jawed
ça devrait te convenir

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Sub suppDouble()
Dim cell As Range, TWf1 As Range, TWf2 As Range
Set TWf1 = Sheets("Feuil1").Range("G1:" & Sheets("Feuil1").Cells( _
           Rows.Count, 7).End(xlUp).Address)
Set TWf2 = Sheets("Feuil2").Range("G1:" & Sheets("Feuil2").Cells( _
           Rows.Count, 7).End(xlUp).Address)
For Each cell In TWf1
    If Not IsError(Application.Match(cell.Value, TWf2, 0)) Then
       cell.EntireRow.Delete
       End If
 Next
End Sub

Bonne journée jawed de la part de nas TIARET :lol:

25/02/2008, 21h07
jawed

bonsoir Abed_H
j'ai testé ton code il est parfait mais il lui monque une seul chose c'est qu'il suprime les doublons mais moi je veut que le client disparesse completement de la feuille1
Nb:j'ai remarqué que le code ne marche pas en boucle continu peut tu remédié a cela merci d'avance
merci pour votre patiente a bientot
Cordialement ;)

Bonsoir jawed
Donc si tu veux que le client disparaisse complètement de la feuille1
essaie ce code, chez moi il fonctionne parfaitement.
NB : Attention il faut le mettre dans un module standart.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Sub suppDouble() i = 2 Do Until IsEmpty(Feuil2.Cells(i, 7)) Cd = Feuil2.Cells(i, 7) For Each cell In Feuil1.Range("G1:" & Cells(Rows.Count, "G").End(xlUp).Address) If cell.Value = Cd Then cell.EntireRow.Delete End If Next i = i + 1 Loop End Sub
Bonne soirée jawed ;)

25/02/2008, 22h20
jawed

merci Abed_H pour ta rapidité
ce module aussi laisse aprés son execution un client qui existe dans la feuille2 pour bien nous faire comprendre ce que je dire par suprimer le client c'est que exemple: s'il y a 5 Phone identique dans la feuille1 et si ce phone existe dans la feuille2 ton module suprimera les 5 phone de la feuille1.
Nb:pour avoir le resultat volu je doit executé ton modul plusieur fois
au plaisir de te lire
cordialement ;)
27/02/2008, 20h21
jawed

salut Abed_H
desolé effectivement ton module me suprime les client dela feuille2 j'ai mal interpreté mes données donc je declare ceposte :resolu:
juste une petite question hors sujet que me conseille-tu pour apprendre ce magnifique language qui est le VBA ???
encors merci
cordialement ;)
27/02/2008, 22h21
Abed_H

Bonsoir jawed
désolé je n'ai pas trouvé de solution définitif à ton problème :marteau:
À bientôt

Bonne soirée