[VB pour Excel 2010] Fusion, suppression, doublons,..
Résolu/Fermé
guigs.pro
-
4 févr. 2013 à 17:02
guigs.pro Messages postés 8 Date d'inscription mardi 5 février 2013 Statut Membre Dernière intervention 25 mars 2014 - 7 févr. 2013 à 17:59
guigs.pro Messages postés 8 Date d'inscription mardi 5 février 2013 Statut Membre Dernière intervention 25 mars 2014 - 7 févr. 2013 à 17:59
A voir également:
- [VB pour Excel 2010] Fusion, suppression, doublons,..
- Liste déroulante excel - Guide
- Supprimer les doublons excel - Guide
- Forcer suppression fichier - Guide
- Formule excel - Guide
- Doublons photos - Guide
7 réponses
eriiic
Messages postés
24569
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
28 décembre 2023
7 211
Modifié par eriiic le 7/02/2013 à 15:18
Modifié par eriiic le 7/02/2013 à 15:18
Bonjour,
eric
Jamais tu ne répondras à un mp non sollicité...
Bon, ça c'est fait.
Sub suppEmail() Dim derlig As Long, nb_email, i As Long Columns("B:B").Insert Shift:=xlToRight derlig = Cells(Rows.Count, "A").End(xlUp).Row Application.ScreenUpdating = False [B2].Resize(derlig - 1, 1).FormulaLocal = "=NB.SI(A:A;A2)" nb_email = [B1].Resize(derlig, 1) Columns(2).Delete For i = UBound(nb_email) To 2 Step -1 If nb_email(i, 1) > 1 Then Rows(i).Delete Next i Application.ScreenUpdating = True End Sub
eric
Jamais tu ne répondras à un mp non sollicité...
Bon, ça c'est fait.
eriiic
Messages postés
24569
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
28 décembre 2023
7 211
Modifié par eriiic le 4/02/2013 à 22:27
Modifié par eriiic le 4/02/2013 à 22:27
Bonjour,
ton code n'est pas orthodoxe et est difficile à lire, pas indenté, je ne l'ai donc pas trop regardé...
Le principe lorsque tu supprimes des lignes est de faire une boucle à l'envers : démarrer de la dernière ligne et remonter.
Sinon si tu supprimes la ligne 5, la 6 devient la 5 est n'est pas vue si tu n'en tiens pas compte dans ta boucle.
eric
Jamais tu ne répondras à un mp non sollicité...
Bon, ça c'est fait.
ton code n'est pas orthodoxe et est difficile à lire, pas indenté, je ne l'ai donc pas trop regardé...
Le principe lorsque tu supprimes des lignes est de faire une boucle à l'envers : démarrer de la dernière ligne et remonter.
Sinon si tu supprimes la ligne 5, la 6 devient la 5 est n'est pas vue si tu n'en tiens pas compte dans ta boucle.
eric
Jamais tu ne répondras à un mp non sollicité...
Bon, ça c'est fait.
guigs.pro
Messages postés
8
Date d'inscription
mardi 5 février 2013
Statut
Membre
Dernière intervention
25 mars 2014
5 févr. 2013 à 09:11
5 févr. 2013 à 09:11
Bonjour,
Merci pour la réponse.
Si je comprends bien, lorsque je fais un ActiveCell.EntireRow.Delete, je n'ai pas besoin de faire le OffSet mais simplement un ActiveCell.Select() pour prendre en compte la ligne du dessous qui est devenu la cellule active ?
Je remets le code un peu mieux organisé.
Désolé, l'indentation n'est pas prise en compte dans les messages de ce forum :/
Merci pour la réponse.
Si je comprends bien, lorsque je fais un ActiveCell.EntireRow.Delete, je n'ai pas besoin de faire le OffSet mais simplement un ActiveCell.Select() pour prendre en compte la ligne du dessous qui est devenu la cellule active ?
Je remets le code un peu mieux organisé.
Désolé, l'indentation n'est pas prise en compte dans les messages de ce forum :/
Private Sub Workbook_Open() MaCellule = InputBox("Veuillez saisir l'adresse de la 1ere cellule à comparer") 'récupère l'adresse de la cellule dans une variable MaCellule Range(MaCellule).Select ActiveCell.CurrentRegion.Sort Key1:=Range(MaCellule), Order1:=xlAscending, Header:=xlYes i = 0 donnee1 = ActiveCell.Value 'mémorise le contenu de la cellule et l'affecte à donnée 1 donnee2 = ActiveCell.Address 'mémorisation de la première ligne afin de pouvoir y revenir et la supprimer en cas de doublon ActiveCell.Offset(1, 0).Select i = i + 1 a = 0 While Not IsEmpty(ActiveCell.Value) 'tant que la cellule n'est pas vide If (ActiveCell.Value = donnee1) Then ActiveCell.EntireRow.Delete a = 0 Range(donnee2).Select ' Je sélectionne la première cellule qui contenait la donnée ActiveCell.EntireRow.Delete i = 0 donnee1 = ActiveCell.Value donnee2 = ActiveCell.Address ActiveCell.Offset(1, 0).Select i = i + 1 ' Je descends d'une ligne ElseIf (ActiveCell.Value = "") And (donnee1 <> "") Then ActiveCell.Offset(1, 0).Select i = i + 1 Else ActiveCell.Offset(1, 0).Select i = i + 1 End If Wend End Sub
eriiic
Messages postés
24569
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
28 décembre 2023
7 211
5 févr. 2013 à 11:10
5 févr. 2013 à 11:10
Le mieux serait quand même un petit fichier exemple.
Déposer le fichier xls (réduit au nécessaire et anonymisé) sur cjoint.com et coller ici le lien fourni.
eric
Déposer le fichier xls (réduit au nécessaire et anonymisé) sur cjoint.com et coller ici le lien fourni.
eric
guigs.pro
Messages postés
8
Date d'inscription
mardi 5 février 2013
Statut
Membre
Dernière intervention
25 mars 2014
5 févr. 2013 à 14:36
5 févr. 2013 à 14:36
Ok , le voici : https://www.cjoint.com/?0BfoHzs7btI
Sinon on m'a aussi conseillé d'utiliser "findNext" du coup c'est ce que j'ai fait via ce lien :
https://www.cjoint.com/?0BfoJAnl7iO
Merci pour l'aide et la réactivité
Sinon on m'a aussi conseillé d'utiliser "findNext" du coup c'est ce que j'ai fait via ce lien :
https://www.cjoint.com/?0BfoJAnl7iO
Merci pour l'aide et la réactivité
guigs.pro
Messages postés
8
Date d'inscription
mardi 5 février 2013
Statut
Membre
Dernière intervention
25 mars 2014
6 févr. 2013 à 17:21
6 févr. 2013 à 17:21
Finalement quelqu'un m'a aidé sur un autre forum et a résolu le problème de suppression (les adresses en doubles sont supprimées toutes les deux), mais j'ai un nouveau problème, c'est que les adresses uniques sont aussi supprimées et là je sèche :/
Auriez-vous une idée ? Merdi, voici le code :
Auriez-vous une idée ? Merdi, voici le code :
Sub FindNext() Dim tableau() As Variant With Worksheets(1).Range("A1").EntireColumn valeur = Range("A1") Set c = .Find(valeur, LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address End If Do adresse = adresse & c.Address & "," Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> firstAddress adresse = Left(adresse, Len(adresse) - 1) End With Sheets(1).Range(adresse).EntireRow.Delete End Sub
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
eriiic
Messages postés
24569
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
28 décembre 2023
7 211
6 févr. 2013 à 23:07
6 févr. 2013 à 23:07
On va attendre que tu aies la réponse sur l'autre forum.
Ca ne sert à rien d'être plusieurs à chercher la même chose.
eric
Ca ne sert à rien d'être plusieurs à chercher la même chose.
eric
guigs.pro
Messages postés
8
Date d'inscription
mardi 5 février 2013
Statut
Membre
Dernière intervention
25 mars 2014
7 févr. 2013 à 09:09
7 févr. 2013 à 09:09
Justement ils n'ont pas la réponse, c'est pour ça que je poste ici.
Comme il n'y a qu'une personne qui répond et qui m'aide sur l'autre forum, peut-être qu'ici avec un regard neuf quelqu'un me dira que qu'en fait c'est tout bête il suffit de rajouter ça ou ça..
Comme il n'y a qu'une personne qui répond et qui m'aide sur l'autre forum, peut-être qu'ici avec un regard neuf quelqu'un me dira que qu'en fait c'est tout bête il suffit de rajouter ça ou ça..
guigs.pro
Messages postés
8
Date d'inscription
mardi 5 février 2013
Statut
Membre
Dernière intervention
25 mars 2014
7 févr. 2013 à 17:59
7 févr. 2013 à 17:59
Bonjour,
Merci pour ce code !!!!!
Il fonctionne parfaitement.
Entre temps j'avais aussi trouvé une solution avec le code suivant pour ceux que ça intéresse (néanmoins le code d'eric a l'air de mieux fonctionner puisque le mien gère une seule cellule vide) :
Merci pour ce code !!!!!
Il fonctionne parfaitement.
Entre temps j'avais aussi trouvé une solution avec le code suivant pour ceux que ça intéresse (néanmoins le code d'eric a l'air de mieux fonctionner puisque le mien gère une seule cellule vide) :
Sub FindNext() Dim tableau() As Variant With Worksheets(1).Range("A1").EntireColumn Range("A1").Select Do valeur = ActiveCell.Value Set c = .Find(valeur, LookIn:=xlValues) If Not c Is Nothing Then firstaddress = c.Address End If Do Set c = .FindNext(c) If Not c Is Nothing Then adresse = adresse & c.Address & "," End If Loop While Not c Is Nothing And c.Address <> firstaddress If adresse <> "" And Len(adresse) > 8 Then adresse = Left(adresse, Len(adresse) - 1) 'adresse = adresse & Range(firstaddress).Address .Range(adresse).EntireRow.Delete adresse = "" ActiveCell.Offset(1, 0).Select Else: adresse = "" ActiveCell.Offset(1, 0).Select End If Loop While ActiveCell.Value <> "" End With End Sub