Microsoft 365 Effacer dans colonne "G" les cellules qui ne contiennent pas un mot

[Usine à gaz]

Bonjour à toutes et à tous

Je bute sur un souci de codification (évidemment lol )
Je voudrais comme indiqué dans le titre du fil "Effacer dans colonne "G" les cellules qui ne contiennent pas un mot" dans l'exemple le mot "Date".

J'ai tenté, testé et recherché... j'ai trouvé un code sur un site que j'ai tenté d'adapter sans y arriver :

Sub NETTOYAGE()
Dim plage As Range
Dim i As Long
Dim vval As String
'Plage de recherche ici G2 à Derniere cellule utilisée de colonne G
Set plage = Range("g2" & ":g" & Range("g65000").End(xlUp).Row) 'Range("g:g")

'Pour chaque cellule de la plage de recherche
For i = plage.Rows.Count To 1 Step -1
    'je met dans une variable les 3 premiers caractères de la cellule
    'vval = Left(plage.Cells(i, 7).Value, 4)
    'Si vval = total alors j'efface la ligne entiere
    ' on utilise StrComp avec vbTextCompare pour ne pas tenir compte de la case (minuscules/majuscules)
    If StrComp(vval, "Date", vbTextCompare) <> 0 Then
        plage.Cells(i, 7).ClearContents
    End If
Next i
End Sub

Dans mon exemple (fichier joint), je voudrais qu'il m'efface tous les "ff" et garde les "Date"
Lol : ça n'efface rien du tout (nada, queue d'ail...)

Vous voudriez bien me corriger ?

Un grand merci par avance.
Fichier joint et je continue mes recherches...
lionel

 

[sylvanu]

Re,
Que l'on mette :
Range("g65000").End(xlUp).Row ou Cells(Cells.Rows.Count, "G").End(xlUp).Row c'est la même chose.
Dans le fichier de Lionel on trouve dans les deux cas 45, qui est dernière ligne.
Mais quand on fait "Set plage" et qu'on commence à 2 alors le "plage.Rows.Count" vaut 44, et non 45.
D'où la simplification du post #10 qui évite le "set" et le "+1".

 

[Staple1600]

Bonjour le fil

Une autre façon de faire
(pas de boucle , mais une feuille complémentaire)

Sub Test_OK()
With Sheets("Feuil2")
    .Range("A2").Formula2 = "=NOT(EXACT(Feuil1!G2,""Date""))"
    Sheets("Feuil1").Range("G1:G45").AdvancedFilter Action:=2, CriteriaRange:=Range("A1:A2"), CopyToRange:=.Range("G1"), Unique:=0
End With
End Sub

NB: Evite de maltraiter la feuille 1
(On se sait jamais )

Donc pour tester, ajouter une feuille (et de de préférence donner lui le petit nom de : Feuil2)
ou faites les adaptations selon vos choix.

 

[dysorthographie]

hors mis que je ne vois pas l'intérêt de partir de la fin de la plage, ton code était presque bon!

Sub NETTOYAGEé()
Dim i As Integer
With Sheets("Feuil1").Range(Range("g2"), Cells(Cells.Rows.Count, "G").End(xlUp))
   For i = .Rows.Count To 1 Step -1
   Debug.Print .Cells(i, 1)
    If StrComp(.Cells(i, 1), "Date", vbTextCompare) <> 0 Then
        .Cells(i, 1).ClearContents
    End If
Next i
End With
End Sub

je t'invites à ne pas faire orgies de variable que ce qui est utile pour que ton code reste lisible!

si tu prend la plage

Set plage = Range("g2" & ":g" & Range("g65000").End(xlUp).Row) 'Range("g:g")

alors il n'y a qu'une colonne dans ta plage donc

plage.Cells(i, 1).ClearContents

 

[mapomme]

Juste pour vous saluer tous ,

Sub Nettoyage()
Dim t, i
   t = Range("g2:g" & Cells(Rows.Count, "g").End(xlUp).Row)
   For i = 1 To UBound(t): t(i, 1) = IIf(LCase(t(i, 1)) = LCase("Date"), "Date", Null): Next
   Range("g2").Resize(UBound(t)) = t
End Sub

 

[dysorthographie]

chez moi tout ce qui ne contient pas le mot "Date" est effacé!

 

[Usine à gaz]

Bonjour le fil

Une autre façon de faire
(pas de boucle , mais une feuille complémentaire)

Sub Test_OK()
With Sheets("Feuil2")
    .Range("A2").Formula2 = "=NOT(EXACT(Feuil1!G2,""Date""))"
    Sheets("Feuil1").Range("G1:G45").AdvancedFilter Action:=2, CriteriaRange:=Range("A1:A2"), CopyToRange:=.Range("G1"), Unique:=0
End With
End Sub

NB: Evite de maltraiter la feuille 1
(On se sait jamais )

Donc pour tester, ajouter une feuille (et de de préférence donner lui le petit nom de : Feuil2)
ou faites les adaptations selon vos choix.

Bjr JM, merci d'être là toi aussi
ça fonctionne également nickel et je t'en remercie
J'ai pas compris le filtrage (puisque ça ne filtre pas lol)
Je joins le fichier test avec ton code intégré...
(j'ai nommé Feuil1 > test2

 

[mapomme]

Re,

Le problème c'est qu'avec l'utilisation de STRCOMP, on est en droit s'interroger de ce que désire réellement @Usine à gaz puique Strcomp("Date","DATE", vbTextCompare)=0 donc <>0 donc le code de @Usine à gaz l'efface...
Donc si une cellule est strictement égale à "Date"; le code l'efface.

 

[Usine à gaz]

Juste pour vous saluer tous ,

Sub Nettoyage()
Dim t, i
   t = Range("g2:g" & Cells(Rows.Count, "g").End(xlUp).Row)
   For i = 1 To UBound(t): t(i, 1) = IIf(LCase(t(i, 1)) = LCase("Date"), "Date", Null): Next
   Range("g2").Resize(UBound(t)) = t
End Sub

Bjr et merci Mapomme,
Nickel, voilà encore une autre version qui fonctionne.
Et re-fichier test joint avec ta version

 

[sylvanu]

Lionel,
Pour être sur de bien tout effacer, le mieux est de faire :

Sub Efface()
    Call NETTOYAGEG
    Call NETTOYAGESylvanuSimplifié
    Call NETTOYAGEVG
    Call NettoyageMapomme
End Sub

 

[Usine à gaz]

Lionel,
Pour être sur de bien tout effacer, le mieux est de faire :

Sub Efface()
    Call NETTOYAGEG
    Call NETTOYAGESylvanuSimplifié
    Call NETTOYAGEVG
    Call NettoyageMapomme
End Sub

J'apprécie ton humour
Pour être vraiment certain : je peux aussi mettre le fichier à la poubelle et l'enterrer profond

 

[Staple1600]

@Usine à gaz
La macro utilise le filtre avancé
et le critère du filtre est dans la cellule A2 de la feuille 2
(c'est une formule)
Et je choisis l'option: Copier vers un emplacement
(pour éviter des suppressions malencontreuses sur la feuille 1
D'où le

NB: Evite de maltraiter la feuille 1
(On se sait jamais )

 

[Usine à gaz]

@Usine à gaz
La macro utilise le filtre avancé
et le critère du filtre est dans la cellule A2 de la feuil 2
(c'est une formule)
Et je choisis l'option: Copier vers un emplacement
(pour éviter des suppressions malencontreuses sur la feuille 1
D'où le

Merci JM pour ce retour

 

[vgendron]

Hello tous

pour tout effacer.. avant de jeter le fichier à la poubelle
cells.clear.. et on en parle plus

voila. c'était juste pour déconner

 

[dysorthographie]

aller une autre version pour le poste #25

Sub NETTOYAGE2()
Dim i As Integer
With Sheets("Feuil1").Range(Range("g2"), Cells(Cells.Rows.Count, "G").End(xlUp))
   For i = .Rows.Count To 1 Step -1
   Debug.Print .Cells(i, 1)
    If Not CBool(InStr(.Cells(i, 1), "Date")) Then
        .Cells(i, 1).ClearContents
    End If
Next i
End With
End Sub