Macro de recherche et suppression

Signaler
Messages postés
21
Date d'inscription
mercredi 26 avril 2006
Statut
Membre
Dernière intervention
12 septembre 2006
-
Messages postés
21
Date d'inscription
mercredi 26 avril 2006
Statut
Membre
Dernière intervention
12 septembre 2006
-
Bonjour tout le monde, <?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /??>


je vous écris par rapport à un problème que j'ai rencontré en VBA :


J'ai une feuille excel sur laquelle figure dans une colonne (A) différentes chaînes de caractère classées par ordre alphabétique. Il y a 2000 lignes, et certaines chaînes de caractère sont parfois présentes plusieurs fois.


J'ai essayé de créer une macro qui permet supprimer les chaînes de caractères qui apparaissent plusieurs fois (afin de n'en laisser qu'une).


Mon programme devrait permettre de sélectionner la première cellule de la colonne, la comparer avec les autres.


- dans le cas où elle trouve d'autres cellules identiques elle les supprime


- dans le cas où aucune autre cellule n'est identique, elle sélectionne la deuxième cellule du tableau pour commencer une nouvelle comparaison...



 










i = 1





j = 1





selection1 = Cells(i, 1).Select





message1 = selection1





Do






    j = j + 1






    selection2 = Cells(j, 1).Select






    message2 = selection2






    If message1 = message2 Then Cells(j, 1).delet






    Else: GoTo line11





Loop While j < 2000






 






Do






    i = i + 1






    j = i






    selection1 = Cells(i, 1).Select






    message1 = selection1






    Do






        j = j + 1






        selection2 = Cells(j, 1).Select






        message2 = selection2






        If message1 = message2 Then Cells(j, 1).delet






        Else: GoTo Line19






            Loop While j < 2000




Loop While i < 2000






 




Celui-ci ne marche pas malgré tout, je rencontre un pbm avec le else (le commentaire me dit qu'il n'y a pas de if... :s )



 




Je remercie celui qui pourra me débloquer.


Aussi, pensez-vous que ce programme puisse fonctionner correctement?


Merci

8 réponses

Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
Salut,

<small>
Coloration syntaxique automatique </small>
Sub Test() 
    Dim sNomFeuille         As String 
    Dim sNomFeuilleActu     As String 

sNomFeuilleActu = ActiveSheet.Name 

Sheets.Add 
sNomFeuille = ActiveSheet.Name 

Sheets(sNomFeuilleActu).Select 
Columns("A:A").Select 
Range("A1:A40").AdvancedFilter Action:=xlFilterInPlace, Unique:=True 
Columns("A:A").Select 
Selection.Copy 

Sheets(sNomFeuille).Select 

ActiveSheet.Paste 

Sheets(sNomFeuilleActu).Select 
ActiveSheet.ShowAllData 

Sheets(sNomFeuille).Select 
Columns("A:A").Select 
Selection.Copy 

Sheets(sNomFeuilleActu).Select 
ActiveSheet.Paste 

Application.DisplayAlerts = False 
Sheets(sNomFeuille).Delete 
Application.DisplayAlerts = True 
End Sub 
<small>
Coloration syntaxique automatique</small>

@++

<hr size="2" width="100%" />
  --Mortalino--
Le mystérieux chevalier, "Provençal, le Gaulois"
<!--
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
remplace
Range("A1:A40").AdvancedFilter Action:=xlFilterInPlace, Unique:=True par
Selection.AdvancedFilter Action:=xlFilterInPlace, Unique:=True

@++

<hr size="2" width="100%" />
  --Mortalino--
Le mystérieux chevalier, "Provençal, le Gaulois"
<!--
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
19
Salut,

Ce code provient d'une macro complémentaire (xla) que je me suis créée

Il comporte un UserForm qui contient un textbox dans lequel on inscrit
la lettre de la colonne à vérifier. Il te suffit d'adapter.


L'important c'est de commencer par la fin si on supprime une ligne. Et
aussi que la colonne soit triée. Donc les valeurs identiques se
suivront.


Pour tes besoins la partie importante est en bleu.


Private Sub CommandButton1_Click()

    Dim I As Long, nbLignes As Long

    Dim Colonne As String

   

    On Error GoTo Erreur

   

    Colonne = UCase(UserForm1.TextBox1.Text)
    nbLignes = Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row

   

    For I = nbLignes To 2 Step -1

        If Range(Colonne & I) = Range(Colonne & I - 1) Then

            Rows(I).Delete

        End If

    Next
   

    Unload Me

   

    Exit Sub

Erreur:

    MsgBox Err.Description

End Sub

MPi
Messages postés
21
Date d'inscription
mercredi 26 avril 2006
Statut
Membre
Dernière intervention
12 septembre 2006

Merci à tous les deux pour vos réponses,
Mortalino, j'aurais quelques questions à propos de ton code :

'Tu définis ci-dessous deux feuilles : sNomFeuille et sNomFeuilleActu. Cela permet d'utiliser le programme quelque soit le nom des deux première feuilles Excel c'est ça? :) Je ne connaissais pas merci 

Sub Test() 
    Dim sNomFeuille         As String
 
    
Dim sNomFeuilleActu     As String 

sNomFeuilleActu = ActiveSheet.Name 

Sheets.Add 
sNomFeuille = ActiveSheet.Name 
'Tu sélectionnes la première feuille
Sheets(sNomFeuilleActu).Select 
'cela signifie que tu sélectionnes la première colonne
Columns("A:A").Select 
'Je ne comprends pas cette ligne :( Pourquoi ligne 1 à 40 de la colonne A...?
Range("A1:A40").AdvancedFilter Action:=xlFilterInPlace, Unique:=True 
Columns("A:A").Select 
'tu copies et colle la sélection et la colle sur la feuille sNomFeuille 
Selection.Copy 

Sheets(sNomFeuille).Select 

ActiveSheet.Paste 

'tu sélectionnes la feuille sNomFeuilleActu et ej ne comprends pas ce que fait ShowAllData 
Sheets(sNomFeuilleActu).Select 
ActiveSheet.ShowAllData 

'Tu prends le résultat de la feuille sNomFeuille pour les copier sur l'autre
Sheets(sNomFeuille).Select 
Columns("A:A").Select 
Selection.Copy 

Sheets(sNomFeuilleActu).Select 
ActiveSheet.Paste 

Application.DisplayAlerts = 
False 
'tu supprimes les infos de la feuille sNomFeuille
Sheets(sNomFeuille).Delete 
Application.DisplayAlerts = 
True 
End Sub 

En tout cas, je te remercie énormément pour ton aide mortalino ,
@+
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
Salut,

ben en fait, ne connaissant pas le nom de ta feuille où cela se passe, je le récupère et le place dans la variable sNomFeuilleActu
, puis j'insère une nouvelle feuille temporairement, et pareil, ne connaissant pas le nombre de feuilles que tu as, je ne peux deviner le nom de cette feuille, ce qui fait qu'après création, je récupère également son nom que je place dans la variable sNomFeuille
afin de pouvoir travailler avec.

C'est juste pour travailler avec les feuilles, avec peu de risque de plantages.

@++

<hr size="2" width="100%" />
  --Mortalino--
Le mystérieux chevalier, "Provençal, le Gaulois"
<!--
Messages postés
21
Date d'inscription
mercredi 26 avril 2006
Statut
Membre
Dernière intervention
12 septembre 2006

Je te remercie Mortalino,
Pourrais-tu par ailleurs m'expliquer s'il te plaît ces deux lignes ci-dessous que j'ai du mal à comprendre  :


'Je ne comprends pas cette ligne : Pourquoi ligne 1 à 40 de la colonne A...?

Range("A1:A40").AdvancedFilter Action:=xlFilterInPlace, Unique:=True 
Columns("A:A").Select

'tu sélectionnes la feuille sNomFeuilleActu et je ne comprends pas ce que fait ShowAllData 
Sheets(sNomFeuilleActu).Select 
ActiveSheet.ShowAllData  

Merci d'avance
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
pour le Range("A1:A40").
c'était une erreur (par rapport à mes test) mais je t'avais mis la correction un peu plus haut ^^

Il faut le remplacer par Selection.

Concernant la fonction ").AdvancedFilter Action:=xlFilterInPlace, Unique:=True 
C'est pour faire une extraction de données sans doublons et sur place,
mais en fait, il ne fait que masquer les cellules contenant ces doublons.

On les copie donc sur une nouvelle feuille et on revient sur la page initiale :
Il faut donc ensuite les rendre à nouveau visible (les lignes masquées):
Sheets(sNomFeuilleActu).Select 
ActiveSheet.ShowAllData

puis coller les nouvelles données (donc sans doublons) par dessus.

Pour avoir un aperçu de ce que ça fait, place cette procédure dans un modules, réduit la fenêtre de VB en plus pétit et décalé (de façon à voir excel), place le curseur dans la procédure Test et appuie sur F8, cela exécute la procédure pas à pas.

@++

<hr width="100%" size="2" />
  --Mortalino--
Le mystérieux chevalier, "Provençal, le Gaulois"
/DIV>
Messages postés
21
Date d'inscription
mercredi 26 avril 2006
Statut
Membre
Dernière intervention
12 septembre 2006

ah d'accord  je te remercie mortalino pour toutes ces explications
@+++