comparaison de ligne

Bonjour
As tu seulement essayé celui proposé?
il offre 2 possibilités, soit mettre en caractère Gras tous les doublons,
soit supprimer les doublons.

<artintel@free.fr> a écrit dans le message de news:
9f0154e6-3fcb-4807-91dd-cf7687f54639@40g2000prx.googlegroups.com...
Bonsoir,

Merci pour ton aide, mais j'ai progresse de mon cote, il ne me manque
plus qu'a recuperer les doublons dans un tableau dynamique, ca je sais
pas faire ... Voici le code qui m'affiche tous les doublons :

Sub choiCelule_02()
Dim celluleAi As String
Dim celluleBi As String
Dim celluleCi As String
Dim celluleAj As String
Dim celluleBj As String
Dim celluleCj As String
Dim i
Dim j
Dim k
derLigne = [A65536].End(3).Row
MsgBox derLigne
i = 1
j = 1
k = 0
While i < derLigne
celluleAi = "A" & i
celluleBi = "B" & i
celluleCi = "C" & i
While j <> i And j < derLigne
celluleAj = "A" & j
celluleBj = "B" & j
celluleCj = "C" & j
If ((Range(celluleAi).Value) = (Range(celluleAj).Value)) And
((Range(celluleBi).Value) = (Range(celluleBj).Value)) And
((Range(celluleCi).Value) = (Range(celluleCj).Value)) Then
k = k + 1
MsgBox Prompt:="La cellule doublon a la ligne" & i & " et a comme
valeur " & Range(celluleAi).Value & Range(celluleBi).Value &
Range(celluleCi).Value
End If
j = j + 1
Wend
i = i + 1
Wend
MsgBox k & "Lignes en doublon"
End Sub


Fredo P a écrit :

Bonsoir
a) La dimension de la plage est ? adapter
b) Copiez la proc?dure dans un module VBA

Sub RecheDoublon()
Dim C As Object, Rep As Byte
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo gest
Rep = Inputbox("Vous devez: 1) Rep?rer les doublons" & Chr(10) & "
2) Supprimer les lignes de doublons")
For Each C In Range("A2:A5000") If C <> "" Then
If Evaluate("sum((A2:A5000=""" & C & """)*(B2:B5000=""" & C.Offset(0, 1) &
""")*(C2:C5000=""" & C.Offset(0, 2) & """))") > 1 Then
If Rep = 1 Then
Rows(C.Row).Font.Bold = True
ElseIf Rep = 2 Then
Rows(C.Row).Delete Shift:=xlShiftUp
End If
Else
C.Font.Bold = False
End If
End If
Next C
gest:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

<artintel@free.fr> a ?crit dans le message de news:
839b540c-14de-4a80-a6cc-3b6f2b16cede@v13g2000pro.googlegroups.com...
Je vois pas trop ce que vous me proposez... Vraiment desole, ma
dificulte c'est de parcourir l'ensemble des cellules et de les
traiter... Je pense que vous vous en doutez ;o) J'aurais vu un truc
comme cela :

NOM (colonne A) puis PRENOM(colonne B) puis DATEDE NAISSANCE(colonne
C)

3 colonnes A, B et c correspondant a nom, prenom et dateNaissance

la macro fait

// i variant de 1 a la valeur 'N' du nombre de lignes de la feuille
// j variant de 1 a la valeur 'N' du nombre de lignes de la feuille

i=1
j=2

DEBUT
TANT QUE i<> N

TANT QUE j<>N

SI Ai=Aj
SI Bi=Bj
Si Ci=Cj
METTRE_EN_GRAS(Ai,Bi,Ci)
FIN SI
FIN SI
FIN SI

ELSE j=j+1

FIN TANT QUE j<>N

FIN TANT QUE i<> N
END




Corto a ?crit :
> Bonjour artintel@free.fr,
> Je t'envoie une fonction personnelle que j'ai d?velopp? dans un but
> proche, elle renvoie la plage de donn?es sans les doublons.
> Function Unique(DONNEES As Range) As Variant
> ReDim MONTAB(DONNEES.Rows.Count)
> XCPT = 0
> For Each XXX In DONNEES.Cells
> Set XFND = DONNEES.Find(XXX.Value, LookIn:=xlValues,
> LookAt:=xlWhole)
> If XXX.Row = XFND.Row Then
> MONTAB(XCPT) = XXX
> XCPT = XCPT + 1
> End If
> Next XXX
> ReDim Preserve MONTAB(XCPT - 1)
> Unique = Application.Transpose(MONTAB)
> End Function
> Tu la colles dans un module et ensuite tu peux utiliser la fonction dans
> ta feuille. Attention, c'est une fonction matricielle qu'il faut valider
> par Ctrl+Maj+Entr?e
>
> Corto
>
> artintel@free.fr a ?crit :
> > Bonjour,
> >
> > Dans un fichier qui contient des milliers de lignes pour des milliers
> > de personnes, j'ai le nom, le prenom, la date de naissance pour chaque
> > personne. Je dois faire un controle sur les doublons.
> >
> > Pour le moment je ne sais le faire que visuellement en triant les
> > donnees sur le champ NOM (colonne A) puis PRENOM(colonne B) puis DATE
> > DE NAISSANCE(colonne C). Mais je dois "automatiser" cette tache et je
> > ne sais pas par ou commencer ?
> >

Bonjour,

Oui, mais ca bug et je vois pas quoi en faire ;o[

"Rep = Inputbox("Vous devez: 1) Repérer les doublons" & Chr(10) & "
2) Supprimer les lignes de doublons")
For Each C In Range("A2:A5000") If C <> "" Then
If Evaluate("sum((A2:A5000=""" & C & """)*(B2:B5000=""" & C.Offset(0,
1) &
""")*(C2:C5000=""" & C.Offset(0, 2) & """))") > 1 Then"

Sinon, tu as une idee pour recuperer les valeur dans un tableau ? ;o)

Fredo P a écrit :

Bonjour
As tu seulement essay� celui propos�?
il offre 2 possibilit�s, soit mettre en caract�re Gras to us les doublons,
soit supprimer les doublons.

<artintel@free.fr> a �crit dans le message de news:
9f0154e6-3fcb-4807-91dd-cf7687f54639@40g2000prx.googlegroups.com...
Bonsoir,

Merci pour ton aide, mais j'ai progresse de mon cote, il ne me manque
plus qu'a recuperer les doublons dans un tableau dynamique, ca je sais
pas faire ... Voici le code qui m'affiche tous les doublons :

Sub choiCelule_02()
Dim celluleAi As String
Dim celluleBi As String
Dim celluleCi As String
Dim celluleAj As String
Dim celluleBj As String
Dim celluleCj As String
Dim i
Dim j
Dim k
derLigne = [A65536].End(3).Row
MsgBox derLigne
i = 1
j = 1
k = 0
While i < derLigne
celluleAi = "A" & i
celluleBi = "B" & i
celluleCi = "C" & i
While j <> i And j < derLigne
celluleAj = "A" & j
celluleBj = "B" & j
celluleCj = "C" & j
If ((Range(celluleAi).Value) = (Range(celluleAj).Value)) And
((Range(celluleBi).Value) = (Range(celluleBj).Value)) And
((Range(celluleCi).Value) = (Range(celluleCj).Value)) Then
k = k + 1
MsgBox Prompt:="La cellule doublon a la ligne" & i & " et a comme
valeur " & Range(celluleAi).Value & Range(celluleBi).Value &
Range(celluleCi).Value
End If
j = j + 1
Wend
i = i + 1
Wend
MsgBox k & "Lignes en doublon"
End Sub


Fredo P a �crit :
> Bonsoir
> a) La dimension de la plage est ? adapter
> b) Copiez la proc?dure dans un module VBA
>
> Sub RecheDoublon()
> Dim C As Object, Rep As Byte
> Application.ScreenUpdating = False
> Application.EnableEvents = False
> On Error GoTo gest
> Rep = Inputbox("Vous devez: 1) Rep?rer les doublons" & Chr(10) & "
> 2) Supprimer les lignes de doublons")
> For Each C In Range("A2:A5000") If C <> "" Then
> If Evaluate("sum((A2:A5000=""" & C & """)*(B2:B5000=""" & C.Offset( 0, 1) &
> """)*(C2:C5000=""" & C.Offset(0, 2) & """))") > 1 Then
> If Rep = 1 Then
> Rows(C.Row).Font.Bold = True
> ElseIf Rep = 2 Then
> Rows(C.Row).Delete Shift:=xlShiftUp
> End If
> Else
> C.Font.Bold = False
> End If
> End If
> Next C
> gest:
> Application.ScreenUpdating = True
> Application.EnableEvents = True
> End Sub
>
> <artintel@free.fr> a ?crit dans le message de news:
> 839b540c-14de-4a80-a6cc-3b6f2b16cede@v13g2000pro.googlegroups.com...
> Je vois pas trop ce que vous me proposez... Vraiment desole, ma
> dificulte c'est de parcourir l'ensemble des cellules et de les
> traiter... Je pense que vous vous en doutez ;o) J'aurais vu un truc
> comme cela :
>
> NOM (colonne A) puis PRENOM(colonne B) puis DATEDE NAISSANCE(colonne
> C)
>
> 3 colonnes A, B et c correspondant a nom, prenom et dateNaissance
>
> la macro fait
>
> // i variant de 1 a la valeur 'N' du nombre de lignes de la feuille
> // j variant de 1 a la valeur 'N' du nombre de lignes de la feuille
>
> i=1
> j=2
>
> DEBUT
> TANT QUE i<> N
>
> TANT QUE j<>N
>
> SI Ai=Aj
> SI Bi=Bj
> Si Ci=Cj
> METTRE_EN_GRAS(Ai,Bi,Ci)
> FIN SI
> FIN SI
> FIN SI
>
> ELSE j=j+1
>
> FIN TANT QUE j<>N
>
> FIN TANT QUE i<> N
> END
>
>
>
>
> Corto a ?crit :
> > Bonjour artintel@free.fr,
> > Je t'envoie une fonction personnelle que j'ai d?velopp? dans un but
> > proche, elle renvoie la plage de donn?es sans les doublons.
> > Function Unique(DONNEES As Range) As Variant
> > ReDim MONTAB(DONNEES.Rows.Count)
> > XCPT = 0
> > For Each XXX In DONNEES.Cells
> > Set XFND = DONNEES.Find(XXX.Value, LookIn:=xlValues,
> > LookAt:=xlWhole)
> > If XXX.Row = XFND.Row Then
> > MONTAB(XCPT) = XXX
> > XCPT = XCPT + 1
> > End If
> > Next XXX
> > ReDim Preserve MONTAB(XCPT - 1)
> > Unique = Application.Transpose(MONTAB)
> > End Function
> > Tu la colles dans un module et ensuite tu peux utiliser la fonction d ans
> > ta feuille. Attention, c'est une fonction matricielle qu'il faut vali der
> > par Ctrl+Maj+Entr?e
> >
> > Corto
> >
> > artintel@free.fr a ?crit :
> > > Bonjour,
> > >
> > > Dans un fichier qui contient des milliers de lignes pour des millie rs
> > > de personnes, j'ai le nom, le prenom, la date de naissance pour cha que
> > > personne. Je dois faire un controle sur les doublons.
> > >
> > > Pour le moment je ne sais le faire que visuellement en triant les
> > > donnees sur le champ NOM (colonne A) puis PRENOM(colonne B) puis DA TE
> > > DE NAISSANCE(colonne C). Mais je dois "automatiser" cette tache et je
> > > ne sais pas par ou commencer ?
> > >

Bonjour
Le souci qui t'est apparu provient de l'interprétation de la date pouvant
être en format texte, ce qui n'est pas la même chose qu'en date(numérique).
C'est pour le cas que j'ai changé C.Offset(0, 2) en CDbl(C.Offset(0, 2)).
En Exemple:
http://cjoint.com/?lklUc0o1TS
Avec la procédure corrigée.
Sub RecheDoublon()
Dim C As Object, Rep As Byte
Application.ScreenUpdating = False ' "Application.EnableEvents = False"
n'est utile que pour éviter le recalcul des formules présentes du classeur.
'Application.EnableEvents = False
On Error GoTo gest
Rep = InputBox("Vous devez: 1) Rep?rer les doublons" & Chr(10) & " 2)
Supprimer les lignes de doublons")
For Each C In ActiveSheet.Range("A2:A5000")
If C <> "" Then
'La ligne suivante inscrit une formule matriciel sur D4
' [D4].FormulaArray = "=sum((A2:A500=""" & C & """)*(B2:B500=""" &
C.Offset(0, 1) & """)*(C2:C500=" & CDbl(C.Offset(0, 2)) & "))"

If Evaluate("=sum((A2:A500=""" & C & """)*(B2:B500=""" & C.Offset(0, 1) &
""")*(C2:C500=" & CDbl(C.Offset(0, 2)) & "))") > 1 Then
If Rep = 1 Then
Rows(C.Row).Font.Bold = True
ElseIf Rep = 2 Then
Rows(C.Row).Delete Shift:=xlShiftUp
End If
Else
C.Font.Bold = False
End If
End If
Next C
gest:
Application.ScreenUpdating = True
'Application.EnableEvents = True
End Sub

> >

On 7 nov, 17:00, Misange <misa...@monsite.net> wrote:

Ta solution Jean Philippe ne fonctionne que si tes doublons sont dans
deux lignes qui se suivent... Sinon, pour chaque valeur de la colonne A,
tu dois tester si elle est égale à une autre valeur de la colonne A.
C'est ce que permettent de faire des formules matricielles (somme prod
étant une matricielle qui a le bon gout de ne pas demander une
validation par ctrl maj enter)
Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !http://xlwiki. free.fr/wikihttp://www.excelabo.net

Jean Philippe U a écrit :



> On 7 nov, 13:08, Misange <misa...@monsite.net> wrote:
>> Bonjour,
>> tu peux utiliser une mise en forme conditionnelle.
>> choisi la formule est et inscrit celle-ci
>> =SOMMEPROD(($A$2:$A$100=$A2)*($B$2:$B$100=$B2)*($C$2:$C$100=$C 2))>1
>>   Attention, les 3 plages étudiées doivent avoir la même taill e.
>> Misange migrateuse
>> XlWiki : Participez à un travail collaboratif sur excel !http://xlwi ki.free.fr/wikihttp://www.excelabo.net

>> artin...@free.fr a écrit :

>>> Bonjour,
>>> Dans un fichier qui contient des milliers de lignes pour des milliers
>>> de personnes, j'ai le nom, le prenom, la date de naissance pour chaqu e
>>> personne. Je dois faire un controle sur les doublons.
>>> Pour le moment je ne sais le faire que visuellement en triant les
>>> donnees sur le champ NOM (colonne A) puis PRENOM(colonne B) puis DATE
>>> DE NAISSANCE(colonne C). Mais je dois "automatiser" cette tache et je
>>> ne sais pas par ou commencer ?- Masquer le texte des messages préc édents -
>> - Afficher le texte des messages précédents -

> Une autre solution
> insere une colonne et tu met une formule du style
> =SI(A21=A20&A19=A18;"**********";"")
> tu fais un copier coller vers le bas
> et tout tes doublons aurons des **********
> tu pourras vérifier ces données avant de les suprimer
> a+- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -

Ta raison
- faut faire un trie correct avant
Le terme matricielle me met de l'urticaire, complexe scolaire, et
perso en 20 ans d'excel
j'ai pas pus depassé le cap, et ma solution je m'en sert tres souvent.
A+

Bonjour,

Je voudrais bien essayer ton programme, mais avec tes commentaires
dans mon excel c'est trop prise de tete car je n'arrive pas a savoir
ou ils commencent et ou ils s'arretent.

Est ce que tu peux juste laisser le code ?

Fredo P. a écrit :

Bonjour
Le souci qui t'est apparu provient de l'interpr�tation de la date pouvant
�tre en format texte, ce qui n'est pas la m�me chose qu'e n date(num�rique).
C'est pour le cas que j'ai chang� C.Offset(0, 2) en CDbl(C.Offset (0, 2)).
En Exemple:
http://cjoint.com/?lklUc0o1TS
Avec la proc�dure corrig�e.
Sub RecheDoublon()
Dim C As Object, Rep As Byte
Application.ScreenUpdating = False ' "Application.EnableEvents = Fa lse"
n'est utile que pour �viter le recalcul des formules pr�s entes du classeur.
'Application.EnableEvents = False
On Error GoTo gest
Rep = InputBox("Vous devez: 1) Rep?rer les doublons" & Chr(10) & " 2)
Supprimer les lignes de doublons")
For Each C In ActiveSheet.Range("A2:A5000")
If C <> "" Then
'La ligne suivante inscrit une formule matriciel sur D4
' [D4].FormulaArray = "=sum((A2:A500=""" & C & """)*(B2:B500=""" &
C.Offset(0, 1) & """)*(C2:C500=" & CDbl(C.Offset(0, 2)) & "))"

If Evaluate("=sum((A2:A500=""" & C & """)*(B2:B500=""" & C.Offset( 0, 1) &
""")*(C2:C500=" & CDbl(C.Offset(0, 2)) & "))") > 1 Then
If Rep = 1 Then
Rows(C.Row).Font.Bold = True
ElseIf Rep = 2 Then
Rows(C.Row).Delete Shift:=xlShiftUp
End If
Else
C.Font.Bold = False
End If
End If
Next C
gest:
Application.ScreenUpdating = True
'Application.EnableEvents = True
End Sub
> > >

Bonsoir,

J'ai avance, le code est "bourin" mais il fonctionne. Si quelqu'un
peut me dire comment j'affiche les valeurs d'un tableau ( une colonne
et x lignes) dans un meme message box, je suis preneur ;o)

Sub choiCelule_04()
Dim celluleAi As String
Dim celluleBi As String
Dim celluleCi As String
Dim celluleDi As String
Dim celluleAj As String
Dim celluleBj As String
Dim celluleCj As String
Dim celluleDj As String
Dim tableau() As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
derLigne = [A65536].End(3).Row
i = 1
j = 1
k = 0
l = 0
m = 0
While i < derLigne
j = i + 1
l = j + 1
m = i
celluleAi = "A" & i
celluleBi = "B" & i
celluleCi = "C" & i
celluleDi = "D" & i
While j < l
celluleAj = "A" & j
celluleBj = "B" & j
celluleCj = "C" & j
celluleDj = "D" & j
If ((Range(celluleAi).Value) = (Range(celluleAj).Value)) And
((Range(celluleBi).Value) = (Range(celluleBj).Value)) And
((Range(celluleCi).Value) = (Range(celluleCj).Value)) Then
ReDim Preserve tableau(k)
tableau(k) = (Range(celluleAi).Value) & " " &
(Range(celluleBi).Value) & " " & (Range(celluleCi).Value) & " [ " &
(Range(celluleDi).Value) & " => " & (Range(celluleDj).Value) & " ]"
k = k + 1
End If
j = j + 1
Wend
i = i + 1
Wend
i = 0
k = k - 1
For i = 0 To k
MsgBox Prompt:=i + 1 & " => " & tableau(i)
Next i
End Sub

Le code se trouve sur l'exemple mis sur http://Cjoint.com:
Rappel de procédure:
Faire Alt+F11 > Insertion> Module >copier la procédure de mon fichier
exemple (Sub RecheDoublon()) entièrement >La coller dans le module que tu
viens d'insérer sur ton classeur> vérifier que tu as bien la feuille adéquat
active> exécuter la procédure.

<artintel@free.fr> a écrit dans le message de
news:8adf1584-3abf-4074-b62d-2bffc1605766@b38g2000prf.googlegroups.com...
Bonjour,

Je voudrais bien essayer ton programme, mais avec tes commentaires
dans mon excel c'est trop prise de tete car je n'arrive pas a savoir
ou ils commencent et ou ils s'arretent.
Il ne faut pas faire cela par petit bout, copie toute la procédure et colle
la dans un module de ton classeur.

Est ce que tu peux juste laisser le code ?

Fredo P. a écrit :

Bonjour
Le souci qui t'est apparu provient de l'interpr?tation de la date pouvant
?tre en format texte, ce qui n'est pas la m?me chose qu'en

date(num?rique).

C'est pour le cas que j'ai chang? C.Offset(0, 2) en CDbl(C.Offset(0, 2)).
En Exemple:
http://cjoint.com/?lklUc0o1TS
Avec la proc?dure corrig?e.
Sub RecheDoublon()
Dim C As Object, Rep As Byte
Application.ScreenUpdating = False ' "Application.EnableEvents = False"
n'est utile que pour ?viter le recalcul des formules pr?sentes du

classeur.

'Application.EnableEvents = False
On Error GoTo gest
Rep = InputBox("Vous devez: 1) Rep?rer les doublons" & Chr(10) & " 2)
Supprimer les lignes de doublons")
For Each C In ActiveSheet.Range("A2:A5000")
If C <> "" Then
'La ligne suivante inscrit une formule matriciel sur D4
' [D4].FormulaArray = "=sum((A2:A500=""" & C & """)*(B2:B500=""" &
C.Offset(0, 1) & """)*(C2:C500=" & CDbl(C.Offset(0, 2)) & "))"

If Evaluate("=sum((A2:A500=""" & C & """)*(B2:B500=""" & C.Offset(0, 1) &
""")*(C2:C500=" & CDbl(C.Offset(0, 2)) & "))") > 1 Then
If Rep = 1 Then
Rows(C.Row).Font.Bold = True
ElseIf Rep = 2 Then
Rows(C.Row).Delete Shift:=xlShiftUp
End If
Else
C.Font.Bold = False
End If
End If
Next C
gest:
Application.ScreenUpdating = True
'Application.EnableEvents = True
End Sub
> > >

Un petit oubli, la ligne: If Evaluate("=sum((A2:A500=""" & C &
""")*(B2:B500=""" & C.Offset(0, 1) &

""")*(C2:C500=" & CDbl(C.Offset(0, 2)) & "))") > 1 Then

est à adapter pour ton classeur suivant le nombre de lignes à traiter, ici
elle est volontairement limitée à 500 lignes.

En Exemple:
http://cjoint.com/?lklUc0o1TS

Avec la proc?dure corrig?e.
Sub RecheDoublon()
Dim C As Object, Rep As Byte
Application.ScreenUpdating = False ' "Application.EnableEvents = False"
n'est utile que pour ?viter le recalcul des formules pr?sentes du

classeur.

'Application.EnableEvents = False
On Error GoTo gest
Rep = InputBox("Vous devez: 1) Rep?rer les doublons" & Chr(10) & " 2)
Supprimer les lignes de doublons")
For Each C In ActiveSheet.Range("A2:A5000")
If C <> "" Then
'La ligne suivante inscrit une formule matriciel sur D4
' [D4].FormulaArray = "=sum((A2:A5000=""" & C & """)*(B2:B5000=""" &
C.Offset(0, 1) & """)*(C2:C5000=" & CDbl(C.Offset(0, 2)) & "))"

If Evaluate("=sum((A2:A5000=""" & C & """)*(B2:B5000=""" & C.Offset(0, 1)

&

""")*(C2:C5000=" & CDbl(C.Offset(0, 2)) & "))") > 1 Then
If Rep = 1 Then
Rows(C.Row).Font.Bold = True
ElseIf Rep = 2 Then
Rows(C.Row).Delete Shift:=xlShiftUp
End If
Else
C.Font.Bold = False
End If
End If
Next C
gest:
Application.ScreenUpdating = True
'Application.EnableEvents = True
End Sub
> > >

Bonsoir,

Merci beaucoups pour ton aide, mais, mon programme est sufisant pour
ce que je souhaite.

Je le poste pour les debutants comme moi en macros excel.

Ce programme cherche les doublons sur les 3 colonnes d'un fichier
excel dont les donnees ont ete triees manuellement par le menu donnees/
trier sur ces trois colonnes.

- Il compare les lignes qui se suivent jusqu'a la fin du fichier
Si c'est un doublon il l'ecrit dans une ligne d'un tableau
dynamique "tableau" visual basic a une colonne
- Il ecrit dans une variable string "doublon" l'ensemble des lignes de
ce tableau
- il cree un fichier texte et il ecrit dans ce fichier la variable
string "doublon"

Remarque : la variable l sertr juste a limite la recherche, puisque
le fichier excel est trie et que meme si un doublon est un "triplon"
pour ma recherche c'est pareil.

Sub doublons()
Dim celluleAi As String
Dim celluleBi As String
Dim celluleCi As String
Dim celluleDi As String
Dim celluleAj As String
Dim celluleBj As String
Dim celluleCj As String
Dim celluleDj As String
Dim doublon As String
Dim tableau() As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
derLigne = [A65536].End(3).Row
i = 1
j = 1
k = 0
l = 0
While i < derLigne
j = i + 1
l = j + 1
celluleAi = "A" & i
celluleBi = "B" & i
celluleCi = "C" & i
celluleDi = "D" & i
While j < l
celluleAj = "A" & j
celluleBj = "B" & j
celluleCj = "C" & j
celluleDj = "D" & j
If ((Range(celluleAi).Value) = (Range(celluleAj).Value)) And ((Range
(celluleBi).Value) = (Range(celluleBj).Value)) And ((Range
(celluleCi).Value) = (Range(celluleCj).Value)) Then
ReDim Preserve tableau(k)
tableau(k) = (Range(celluleAi).Value) & " " & (Range
(celluleBi).Value) & (Chr(9)) & (Range(celluleCi).Value) & " [ " &
(Range(celluleDi).Value) & " => " & (Range(celluleDj).Value) & " ]"
k = k + 1
End If
j = j + 1
Wend
i = i + 1
Wend
i = 0
For i = 0 To UBound(tableau)
If i = 0 Then
doublon = "01 - " & tableau(i) & (Chr(13) + Chr(10)) & (Chr(13) + Chr
(10))
End If
If (i > 0) And (i < 9) Then
doublon = doublon & "0" & i + 1 & " - " & tableau(i) & (Chr(13) + Chr
(10)) & (Chr(13) + Chr(10))
End If
If (i > 8) And (i < UBound(tableau)) Then
doublon = doublon & i + 1 & " - " & tableau(i) & (Chr(13) + Chr(10))
& (Chr(13) + Chr(10))
End If
If i = UBound(tableau) Then
doublon = doublon & i + 1 & " - " & tableau(i) & (Chr(13) + Chr(10))
End If
Next i
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:tempdoublon.txt", True)
a.WriteLine (doublon)
a.Close
End Sub

On 13 nov, 20:28, artin...@free.fr wrote:

Bonsoir,

Merci beaucoups pour ton aide, mais, mon programme est sufisant pour
ce que je souhaite.

Je le poste pour les debutants comme moi en macros excel.

Ce programme cherche les doublons sur les 3 colonnes d'un fichier
excel dont les donnees ont ete triees manuellement par le menu donnees/
trier sur ces trois colonnes.

- Il compare les lignes qui se suivent jusqu'a la fin du fichier excel
   Si c'est un doublon il l'ecrit dans une ligne d'un tableau
dynamique "tableau" visual basic a une colonne
- Il ecrit dans une variable string "doublon" l'ensemble des lignes de
ce tableau avec une mise en page "pratique"
- il cree un fichier texte et il ecrit dans ce fichier la variable
string "doublon"

Je l'ai simplifie et la macro previent quand il n'y a pas de doublon
grace a la variable booleenne "pasDeDoublon"

Sub doublons()
Dim celluleAi As String
Dim celluleBi As String
Dim celluleCi As String
Dim celluleDi As String
Dim celluleAiPlus1 As String
Dim celluleBiPlus1 As String
Dim celluleCiPlus1 As String
Dim celluleDiPlus1 As String
Dim doublon As String

Dim tableau() As String

Dim i As Integer
Dim j As Integer
Dim derLigne As Integer

Dim pasDeDoublon As Boolean



derLigne = [A65536].End(3).Row

ReDim tableau(0)
tableau(0) = "Null"

i = 1
j = 0

While i < derLigne
celluleAi = "A" & i
celluleBi = "B" & i
celluleCi = "C" & i
celluleDi = "D" & i
celluleAiPlus1 = "A" & i + 1
celluleBiPlus1 = "B" & i + 1
celluleCiPlus1 = "C" & i + 1
celluleDiPlus1 = "D" & i + 1
If ( j > 0) And ((Range(celluleAi).Value) = (Range
(celluleAiPlus1).Value)) And ((Range(celluleBi).Value) = (Range
(celluleBiPlus1).Value)) And ((Range(celluleCi).Value) = (Range
(celluleCiPlus1).Value)) Then
ReDim Preserve tableau(j)
tableau(j) = (Range(celluleAi).Value) & " " & (Range
(celluleBi).Value) & (Chr(9)) & (Range(celluleCi).Value) & " [ " &
(Range(celluleDi).Value) & " => " & (Range(celluleDiPlus1).Value) &
" ]"
j = j + 1
End If
If ( j = 0) And ((Range(celluleAi).Value) = (Range
(celluleAiPlus1).Value)) And ((Range(celluleBi).Value) = (Range
(celluleBiPlus1).Value)) And ((Range(celluleCi).Value) = (Range
(celluleCiPlus1).Value)) Then
tableau(0) = (Range(celluleAi).Value) & " " & (Range
(celluleBi).Value) & (Chr(9)) & (Range(celluleCi).Value) & " [ " &
(Range(celluleDi).Value) & " => " & (Range(celluleDiPlus1).Value) &
" ]"
j = 1
End If
i = i + 1
Wend

pasDeDoublon = (tableau(0) = "Null")

If (pasDeDoublon = False) Then
i = 0
For i = 0 To UBound(tableau)
If (i = 0) And (UBound(tableau) = 0) Then
doublon = "01 - " & tableau(i)
End If
If (i = 0) And (UBound(tableau) > 0) Then
doublon = "01 - " & tableau(i) & (Chr(13) + Chr(10)) & (Chr(13) +
Chr(10))
End If
If (i > 0) And (i < 9) Then
doublon = doublon & "0" & i + 1 & " - " & tableau(i) & (Chr(13) +
Chr(10)) & (Chr(13) + Chr(10))
End If
If (i > 8) And (i < UBound(tableau)) Then
doublon = doublon & i + 1 & " - " & tableau(i) & (Chr(13) + Chr
(10)) & (Chr(13) + Chr(10))
End If
If (i = UBound(tableau)) And (UBound(tableau) > 0) Then
doublon = doublon & i + 1 & " - " & tableau(i)
End If
Next i
Else
doublon = "Il n'y a pas de doublons"
End If

Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:tempdoublon.txt", True)
a.WriteLine (doublon)
a.Close

End Sub