Gestion des doublons
Bonjour les amis,
Je ne connais pas le VBA, je sais faire des macros avec l'assistant, je vois le code que cela génère, et j'apprends tout doucement, soyez indulgents SVP !
Je suis déjà parvenu à reprendre des macros un peu plus complexes, à les adapter pour mes besoins. Et ça s'arrête là, je n'en ai jamais créé une en code à partir de zéro. Je comprends simplement les rudiments...
Pour un besoin particulier, j'avais repris le code de la page : https://www.excel-pratique.com/fr/blog/gerer-doublons-et-lignes-vides
Et cela fonctionne à merveille. Sauf que maintenant, j'ai besoin de la simplifier car je ne serai plus le seul utilisateur du fichier, et je veux à tout prix éviter des erreurs d'autres utilisateurs.
Ce que j'aimerais faire, c'est supprimer le UserForm qui apparaît au tout début de l'exécution de la macro, et exécuter directement l'action 1, puis choix A.
Ce que j'ai besoin de faire, concrètement, c'est :
1/ identifier les doublons en colonne A (uniquement colonne A, les données des autres colonnes peuvent diverger)
2/ pour chaque doublon trouvé en colonne A, ignorer la première ligne trouvée, mais pour les lignes suivantes, marquer "Doublon" en 66ème colonne (BO)
J'ose à peine montrer mon adaptation du code, qui est bancal, mais qui fonctionne à peu près (avec le UserFoirm du début que je ne sais pas remplacer) :
Sub doublons_et_lignes_vides()
'Macro : Sébastien Mathier - Excel-Pratique.com
'A propos de cette macro : www.excel-pratique.com/fr/blog/gerer-doublons-et-lignes-vides
choix = InputBox("Mise à jour de la base de données" & Chr(10) & Chr(10) & "Veuillez saisir le chiffre '1'")
If choix = "" Then Exit Sub
choix2 = ""
If choix = 1 Then choix2 = InputBox("Veuillez saisir la lettre 'A'", "Gestion des doublons")
If choix2 = "" Then Exit Sub
Application.ScreenUpdating = False
test = Timer
der_ligne = Range(choix2 & Rows.Count).End(xlUp).Row
Dim tab_cells()
ReDim tab_cells(der_ligne - 1)
For ligne = 1 To der_ligne
tab_cells(ligne - 1) = Range(choix2 & ligne)
Next
nb = 0
If choix = 3 Then compteur = 0
For ligne = 1 To der_ligne
contenu = tab_cells(ligne - 1)
If (choix = 1 Or choix = 2) And contenu <> "" Then 'Colorer doublons
For i = 1 To ligne - 1
If contenu = tab_cells(i - 1) And ligne <> i Then 'Si doublon
nb = nb + 1
If choix = 1 Then
Range(choix2 & ligne).Cells.Offset(0, 66).Value = "Doublon"
Else
Range(ligne & ":" & ligne).Interior.ColorIndex = 3
End If
Exit For
End If
Next
End If
If choix = 3 And ligne > 1 And contenu <> "" Then 'Effacer/supprimer doublons
For i = 1 To ligne - 1
If contenu = tab_cells(i - 1) Then 'Si doublon
nb = nb + 1
If choix = 3 Then
Range(ligne + compteur & ":" & ligne + compteur).Delete
compteur = compteur - 1
End If
Exit For
End If
Next
End If
Next
res_test = Format(Timer - test, "0" & Application.DecimalSeparator & "000")
Application.ScreenUpdating = True
If nb = 0 And choix = 5 Then
MsgBox "Aucune ligne vide trouvée ...", 64, "Résultat"
ElseIf nb = 0 Then
MsgBox "Aucun doublon trouvé dans la colonnne " & UCase(choix2) & " ...", 64, "Résultat"
ElseIf choix = 4 Then
MsgBox nb & " doublons supprimés (en " & res_test & " secondes)", 64, "Résultat"
ElseIf choix = 2 Then
MsgBox nb & " doublons marqués en rouge (en " & res_test & " secondes)", 64, "Résultat"
Else
MsgBox "Mise à jour effectuée avec succès", 64, "Résultat"
End If
End Sub
Sinon j'ai essayé cette macro, elle fonctionne (elle est simple, j'aime), mais cette fois, elle me marque tous les enregistrements comme doublon, or je ne veux pas que cette mention apparaisse sur la première ligne détectée, seulement les suivantes :
Sub Doublon()
Dim Plage As Range
Dim Cel As Range
With Worksheets("Data")
'en colonne "A" à partir de A2
Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
'boucle la plage de la feuille "Compte" et cherche chaque valeur
'en correspondance exacte dans la plage de la feuille "Source"
For Each Cel In Plage
If Application.CountIf(Plage, Cel.Value) > 1 Then
Cel.Offset(0, 66).Value = "Doublon"
End If
Next Cel
End Sub
SI vous pouviez m'aider ce serait super sympa (pas seulement d’avoir la réponse mais d’apprendre un peu en même temps, parce que j'ai cherché quand même avant de venir vous demander).
Merci infiniment !!!
Christophe
Bonjour Chris_56, bienvenue sur XLP
Un petit fichier exemple eût été le bienvenu lui aussi
Voici un exemple de code relativement rapide car tout se passe en mémoire. On lit les données en une seule passe au début du code (colonne A) puis on inscrit les résultats en une passe aussi dans la colonne BO à la fin du code. Entre les deux tout le reste se passe en mémoire vive.
Voir le fichier joint (juste parce que c'est votre première question
Dans Module1, le code est entièrement commenté contrairement au code affiché ci-dessous :
Sub RepererDoublons()
Dim der As Long, t, i As Long, maCollec As New Collection, clef, xVal As Boolean
Dim nbDoublon As Long, debut As Single
debut = Timer
With Worksheets("Feuil1")
If .FilterMode Then .ShowAllData
.Range("bo2:bo" & Rows.Count).ClearContents
der = .Cells(Rows.Count, "A").End(xlUp).Row
t = .Range("A2:A" & der).Value
On Error Resume Next
For i = 1 To UBound(t)
clef = LCase(CStr(t(i, 1)))
xVal = False
xVal = maCollec(clef)
If xVal = False Then
maCollec.Add True, clef
t(i, 1) = Empty
Else
t(i, 1) = "doublon"
nbDoublon = nbDoublon + 1
End If
Next i
On Error GoTo 0
.Range("BO2").Resize(UBound(t), 1) = t
MsgBox Format(UBound(t), "#,##0") & " lignes examinées dont " & Format(nbDoublon, "#,##0") & " doublons." & _
vbLf & "Durée : " & Format(Timer - debut, "0.00\ sec.")
End With
End SubBonjour Mafraise,
D'abord bien sûr un immense Merci pour votre retour ! Et surtout aussi pour toutes les explications fournies dans la macro du fichier, intéressant et utile !
La macro proposée correspond bien à mon besoin et fonctionne parfaitement, sauf qu'elle me pose un nouveau petit souci :
.Range("bo2:bo" & Rows.Count).ClearContents
= je n'ai pas besoin de supprimer les données présentes dans la colonne BO, au contraire j'ai besoin de les conserver.
J'ai donc essayé en supprimant la commande ci-dessus, cela ne change rien (et la macro fonctionne bien quand même),
C'est frustrant :) Est-ce que le problème vient de cette commande ?
If xVal = False Then ' c'est un nouvel élément jamais rencontré
' on ajoute la clef à maCollec avec la valeur True
maCollec.Add True, clef
t(i, 1) = Empty
Merci encore !
Christophe
Bonjour @Chris_56
Vous dites:
je n'ai pas besoin de supprimer les données présentes dans la colonne BO, au contraire j'ai besoin de les conserver.
Si j'interprète bien : vous avez déjà des valeurs dans la colonne BO. Vous désirez conserver ces valeurs sauf pour les doublons pour lesquels la valeur en BO doit être changée en "doublon". Est-ce bien cela ?
Si oui, alors la méthode doit être légèrement changée. Actuellement je me sers de du tableau t de la colonne A pour lire les données mais aussi pour les nouvelles valeurs de la colonne BO au fur et à mesure qu'on parcourt le tableau t. Ces nouvelles valeurs sont soit "doublon" soit vide (empty).
Dans votre cas, il faudrait aussi lire le tableau r de la colonne BO (avec les valeurs figurant déjà en colonne BO) et inscrire dans r "doublon" uniquement quand la valeur correspondante dans t est détecté dans doublon. Pour finir c'est la tableau r qu'on transfèrerai dans la colonne BO en retour.
Si j'ai bien interprété, me le dire mais je ne pourrai le faire que vers la fin d'après-midi. Si j'ai mal interprété, me fournir un peu plus d'explications.
Bonjour Mafraise,
Oui absolument, je me suis mal exprimé pardon. Je ne cherche qu'à remplacer la valeur existante en colonne BO que si c'est un doublon, sinon je dois garder la valeur.
Mille mercis !
Chrstophe
Re,
Ok mais je ne pourrai le faire que vers la fin d'après-midi
A plus...
Merci Mafraise.
Pour apprendre et vous remercier aussi, je viens de vous acheter le pack de Cours VBA
Bonne journée !
Re,
J'ai trouvé 10 minutes pour modifier le code et les commentaires.
Est-ce correct ?
MA-GNI-FIQUE !!
Merci infiniment Mafraise, c'est exactement ce que je voulais.
Par contre là vous m'avez tué : J'ai trouvé 10 minutes pour modifier le code et les commentaires.
Merci beaucoup et je vais prendre le temps de m'y mettre, par plaisir... qu'est-ce que j'aimerais savoir en faire autant.
Je risque de revenir vous embêter attention
Excellente continuation !
Mafraise,
Allez une dernière :)
C'est parfait, le dernier code fait parfaitement le job.
Seul hic, si je place un bouton d'exécution de cette macro dans un autre onglet appelé 'Summary', la macro ouvre l'onglet 'Data' et s'arrête (sans planter mais sans rien faire de plus, elle ne marque plus les doublons dans ce cas). Comment faire pour permettre l'utilisation de cette macro depuis un autre onglet ?
Pire encore : j'aurais aimé que cette macro fonctionne depuis l'onglet 'Summary', alors même que l'onglet 'Data' est caché.
Et enfin, à la suite de son exécution, je souhaiterais qu'elle m'actualise les TCD présents dans les onglets 'Summary' et 'Recherche'
J'ai bien essayé quelques variantes du code mais sans succès.
Merci encore si vous pouvez me répondre, sans vouloir abuser de votre gentillesse !
Christophe
PS : on s'éloigne du sujet des doublons
Re
Chris_56 a dit :
j'aurais aimé que cette macro fonctionne depuis l'onglet 'Summary', alors même que l'onglet 'Data' est caché.
Chris_56 a aussi dit :
à la suite de son exécution, je souhaiterais qu'elle m'actualise les TCD présents dans les onglets 'Summary' et 'Recherche'
La version v3 devrait correspondre à vos souhaits.
Seuls les TCD des deux feuilles "Summary" et "Recherche et pas ceux des autres feuilles seront actualisés. Si vous désirez actualiser tous les TCD du classeur alors une seule ligne de code suffira (au lieu des deux boucles dans le code de la v3) : ActiveWorkbook.RefreshAll
Le temps d'exécution est rallongé à cause de cette mise à jour des TCD.
Mafraise,
Je suis absolument ... je cherche mes mots : fasciné, impressionné, reconnaissant... Je n'y serai jamais arrivé tout seul, enfin pas tout de suite du moins !
C'est parfaitement ce dont j'avais besoin, et cela m'aide vraiment à avancer dans ce travail. Je voudrais bien vous montrer le résultat dans son ensemble mais hélas je ne peux pas.
En tous cas je vous remercie infiniment !!!
Excellente continuation à vous !!!
Christophe
Re,
Je voudrais bien vous montrer le résultat dans son ensemble mais hélas je ne peux pas.
Ce n'est pas bien grave. L'essentiel est que vous puissiez avancer dans votre projet
A bientôt, qui sait ?
Avec plaisir Mafraise --> je sais maintenant où vous habitez !