probleme pour eviter les doubons

[Jean Yves]

Bonjour,

dans mes bases de donnees de fichiers clients, pour eviter les doublons, je trie par exemple par nom de dirigeant croissant qui se trouve dans la colonne B, et ensuite dans une nouvelle colonne, je tape la formule =si(B2=B1='faux;'').

Cela m 'inscrit les faux pour indiquer les doublons.

Problème: Il n'est pas possible de trier la colonne où il y a les doublons (car résultat de formule) pour pouvoir les regrouper et supprimer tous les doublons ensembles au lieu comme actuellement de faire la suppression à chaque ligne de 'FAUX'.


Il doit y avoir un moyen plus simple

merci beaucoup de votre réponse

 

[pat1545.]

Salut,

dans la colonne B (par ex) si tu veux voir rapidement les doublons, mets cette formule soit en format condi sur tous les éléments de la colonne B ou en colonne C:

=nb.si($B$1:$B:1000;1) > 1 + la couleur de fond ..
Si 2 noms identiques, ils se metteent TOUS les 2 en couleur choisie.

Patrick

 

[Dugenou]

Bonsoir,

Il ya une solution triviale : c'est de copier ta colonne de calculs et d'en coller la valeur au même endroit : ensuite tu peux trier

Il y a plusieurs solution élégantes : au moins une dans l'espace téléchargement avec le fichier 'doublons ' de Monique et Celeda et une autre que je ne retrouve pas de l'excellent DidierMDF (en recherchant les post sur le mot clef 'doublons' tu trouveras ton bonheur.

Cordialement

 

[ChTi160]

Salut jean yves
bonsoir pat1545
bonsoir Dugenou
une petite Macro a relier a un bouton dans la feuille ou ce trouve ta Base de Données ou autre solution
Sub supprimeDoublon()
Dim cel As Range
Dim derlgn As Integer
derlgn = Range('C65536').End(xlUp).Row 'recherche la dernière ligne du tableau
For Each cel In Range('C5:C' & derlgn) 'ici tu adaptes la colonne ou tu auras les Faux
If cel.Value = 'Faux' Then Rows(cel.Row).EntireRow.Delete
Next
End Sub

Message édité par: ChTi160, à: 17/05/2005 21:53

 

[Monique]

Bonjour,

Par formule(s)

Tes doublons ou pas doublons en colonne C
En F2 :
=SI(NB.SI(C$1:C1;C2)=0;NB.SI($C$1:$C$500;'<='&C2);'')
à copier coller vers le bas.
Tu obtiens un n° par exemplaire.
Si tu tries sur cette colonne F, tu obtiens l'ordre alphabétique

Ou bien en G2 :
=SI(NB.SI(C$1:C1;C2)=0;1+MAX(G$1:G1);'')
Le 1er exemplaire seulement reçoit un n°, l'ordre = celui de la feuille
Tu tries sur la colonne G

Message édité par: Monique, à: 17/05/2005 21:57

 

[pat1545.]

re )

pour le fun (inspirée d'un code de Fred SIGONNEAU): et qui te servira à d'autres moments:
sélection d'une série de données en 1 colonne, (celle à sa droite doit être libre) , clic droit et les versions uniques apparaissent.


Option Explicit

Sub MenuCell() ' 1
Dim Ctrl
For Each Ctrl In Application.CommandBars('Cell').Controls
Ctrl.Enabled = True
Next
With Application.CommandBars('Cell').Controls.Add(msoControlButton)
.Caption = 'Unique à droite'
.BeginGroup = True
.FaceId = 252
.OnAction = 'ValUniquesACote'
End With
End Sub


' 2
Sub ValUniquesACote() ' PlageSrc As Range, CellDest As Range)
'Extrait les valeurs uniques d'une colonne et les renvoie
'dans une autre, à partir de CellDest tiré d'un code de F. Signonneau (pense-je)
Dim Arr1, Elt, Arr2(), Coll As New Collection, i As Integer
'If PlageSrc.Columns.Count > 1 Then Exit Sub ' Mais possible sur 2 colonnes
'Arr1 = PlageSrc.Value
Arr1 = Selection.Value
Dim Colo
Dim line
Dim err
Colo = Selection.Column
line = Selection.Row
For Each Elt In Arr1
On Error Resume Next
Coll.Add Elt, CStr(Elt)
If err.Number = 0 Then
ReDim Preserve Arr2(1 To Coll.Count)
Arr2(Coll.Count) = Elt
End If
On Error GoTo 0
Next
For i = 1 To Coll.Count
If IsEmpty(Cells(line, Colo + 1)) Then
Cells(line + i, Colo + 1).Value = Coll.Item(i)
Else
MsgBox ('cellule voisine non vide')
MsgBox Coll.Item(i)
End If
Next
Application.Transpose (Arr2)
End Sub



Sub Efface_ClicDroit() ' 3
On Error Resume Next
Application.CommandBars('Cell').Controls('Unique à droite').Delete
End Sub

 

[pat1545.]

petite erreur dans la formule proposée:

=nb.si($B$1:$B$1000;B1) > 1
et copier le format en B2 jusqu'à Bxxx

Patrick

 

[jean yves]

Bonsoir,

Merci à vous tous qui vous êtes donné la peine de me répondre

Cela fonctionne

encore merci et vive ce forum que je découvre ce soir

Cordialement

Jean Yves