H
HUGS
Guest
Bonjour tout le monde,
J'ai besoin d'une macro qui, selon la colonne de la cellule sélectionnée, supprime les lignes qui ont des valeurs redondantes ... ainsi dans cette colonne on ne pourra trouver plus d'une fois la m^me valeur une fois que la macro sera passée ...
j'mettais bidouillé ça mais ça marche plus :
=> j'ai du faire des boulettes ... mon plus gros défaut c'est que je dimensione mal les variables alors après ça passe pas partout ;(
J'ai mis un fichier test pour ceux qui veulent s'essayer à l'exercice ...
Par avance merci de votre aide.
HUGS
J'ai besoin d'une macro qui, selon la colonne de la cellule sélectionnée, supprime les lignes qui ont des valeurs redondantes ... ainsi dans cette colonne on ne pourra trouver plus d'une fois la m^me valeur une fois que la macro sera passée ...
j'mettais bidouillé ça mais ça marche plus :
Code:
Sub SupprimerLignesClé()
feuille_courante = ActiveSheet.Name
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Worksheets(feuille_courante)
' N° de la colonne clé
no_col_cle = ActiveCell.Column
cle_courante = ""
nb_suppressions = 0
nb_lignes = 0
' Tri par clé
.Cells(2, no_col_cle).Sort Key1:=.Cells(2, no_col_cle), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
' boucle identifiant le nbre de ligne
nom_champ = 0
For LigneTot = 2 To 65000
nom_champ = .Cells(LigneTot, no_col_cle).Value
If nom_champ = "" Then
Exit For
End If
Next
LigneTot = LigneTot - 1
ValUn = Cells(2, no_col_cle).Value
For Ligne = 3 To LigneTot
nom_champ = .Cells(Ligne, no_col_cle).Value
If nom_champ = ValUn Then .Cells(Ligne, no_col_cle).Value = ""
If nom_champ <> ValUn Then ValUn = .Cells(Ligne, no_col_cle).Value
Next
' Tri par clé
.Cells(2, no_col_cle).Sort Key1:=.Cells(2, no_col_cle), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
' boucle identifiant le nbre de ligne avec valeurs
nom_champ = 0
For LignePleine = 2 To 65000
nom_champ = .Cells(LignePleine, no_col_cle).Value
If nom_champ = "" Then
Exit For
End If
Next
If LignePleine - 1 <> LigneTot Then Range(Rows(LignePleine), Rows(LigneTot)).Select
If LignePleine - 1 <> LigneTot Then Selection.Delete
Cells(2, no_col_cle).Select
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub=> j'ai du faire des boulettes ... mon plus gros défaut c'est que je dimensione mal les variables alors après ça passe pas partout ;(
J'ai mis un fichier test pour ceux qui veulent s'essayer à l'exercice ...
Par avance merci de votre aide.
HUGS