Suppression de cellules avec condition (VBA)

Bonjour,

ça manque de précisions, tableau en plage dans ce cas, de quelles colonnes et combien de lignes?) ou tableau structuré?

Un fichier joint sans données confidentielles serait le bienvenu.

Cdlt

Voici le fichier.

Pour que ce soit plus repérable, j'ai surligné des exemples de cellules et jaune.

Vous remarquerez aussi des textes en rouge, c'est la seconde étape que j'aimerai automatiser : agir sur les textes pour les rendre plus lisible.

En effet, le copier-coller depuis le site n'est pas toujours très "clair" et, par exemple, lieu et date sont accolés dans ce cas.

Merci

Salut,

Voici un petit code, j'espère qu'il te conviendra

Sub suppression()

Dim cell As Range
Dim rlast As Integer

rlast = Range("B1").CurrentRegion.Rows.Count

For Each cell In Range("A1:E" & rlast)
    If cell = "Star" Then
    cell = ""
    cell.Offset(1, 0) = ""
    cell.Offset(2, 0) = ""
    End If
Next cell

End Sub

cordialement,

Bonjour,

Autre méthode:

Sub Rechercher_Star()
    Dim Sh As Worksheet
    Dim Plage As String, Deb As String
    Dim x As Object
    Application.ScreenUpdating = False
    Set Sh = Sheets("LBC")
    Plage = Sh.Range("A1").CurrentRegion.Address
    With Sh.Range(Plage)
        Set x = .Find("Star", lookat:=xlWhole)
        If Err.Number = 0 Then
            If Not x Is Nothing Then
                Deb = x.Address
                Do
                    Range(Sh.Cells(x.Row, x.Column), Sh.Cells(x.Row + 2, x.Column)).ClearContents
                Set x = .FindNext(x)
                On Error Resume Next
                Loop While Not x Is Nothing And x.Address <> Deb
                On Error GoTo 0
            End If
        End If
    End With
End Sub

Pour la question suivante, il va falloir être plus clair en citant des exemples :

Vous remarquerez aussi des textes en rouge, c'est la seconde étape que j'aimerai automatiser : agir sur les textes pour les rendre plus lisible.

En effet, le copier-coller depuis le site n'est pas toujours très "clair" et, par exemple, lieu et date sont accolés dans ce cas.

Cdlt

Merci

Dans le script proposé par Mistergun, la ligne suivante présuppose que la colonne B sert de référence car elle est la plus étendue, mais ça n'est pas systématiquement le cas (ce fichier est un exemple à une date donnée, mais il varie de jour en jour)

rlast = Range("B1").CurrentRegion.Rows.Count 

Les lignes

If cell = "Star" Then
    cell = ""
    cell.Offset(1, 0) = ""
    cell.Offset(2, 0) = ""

Vident les cellules mais ne les suppriment pas Arturo83 propose une autre approche

Sub Rechercher_Star()
    Dim Sh As Worksheet
    Dim Plage As String, Deb As String
    Dim x As Object
    Application.ScreenUpdating = False
    Set Sh = Sheets("LBC")
    Plage = Sh.Range("A1").CurrentRegion.Address

(jusque là, je comprends)

With Sh.Range(Plage)
        Set x = .Find("Star", lookat:=xlWhole)

(que fait cette commande lookat ?)

        If Err.Number = 0 Then
            If Not x Is Nothing Then
                Deb = x.Address

(est-ce que "x.Address" correspond aux coordonnées d'une cellule ?)

                Do
                    Range(Sh.Cells(x.Row, x.Column), Sh.Cells(x.Row + 2, x.Column)).ClearContents

(ici aussi, c'est un "vidage" et non une suppression, n'est-ce-pas ? Et je suppose que le x.Row + 2, c'est pour vider les trois cellules ?)

                Set x = .FindNext(x)
                On Error Resume Next
                Loop While Not x Is Nothing And x.Address <> Deb
                On Error GoTo 0
            End If
        End If
    End With
End Sub

Merci pour vos explications

Le reste, on verra après

(que fait cette commande lookat ?)

Pour ne prendre en compte que le mot "Star" uniquement, s'il y avait "Starlette", celui-ci ne serait pas retenu.

**********************************************************************

(est-ce que "x.Address" correspond aux coordonnées d'une cellule ?)

Oui à la cellule trouvée

*******************************************************************

(ici aussi, c'est un "vidage" et non une suppression, n'est-ce-pas ? Et
je suppose que le x.Row + 2, c'est pour vider les trois cellules ?)

OUI

*******************************************************************

Pour le reste on relance une recherche avec Set x =.findnext(x), pour rechercher la prochaine cellule contenant "Star". On boucle autant de fois qu'on en trouve.

Mais, au fur et à mesure qu'on en trouve on les efface, donc cela génère une erreur lorsqu'il n' en a plus, d'où les lignes de gestion d'erreurs.

Merci pour ces explications Arturo

Testé = ça marche.

J'ai réalisé manuellement la suppression des cellules devenues vides, mais il diot être possible de remplacer "ClearContents" par "SuppCells" (ou quelque chose comme ça) ?

Il reste maintenant à "éclaircir" le reste, c'est à dire:

1) a chaque fois que le copier coller a "soudé" la date à l'adresse comme par exemple "Cagnes-sur-Mer 0680030/01/2024", scinder les deux (même s'ils sont sur la même ligne). Il y a aussi la même chose avec "hier" ou "aujourd'hui" ou encore "xxxxxx dernier à HH:MM" (xxxxxx étant le nom du jour de la semaine). Tant qu'à faire, si je comprends le principe de scission adresse / date, je peux faire les "détails" par moi-même.

2) le mot "vendu" ou "achat en cours" suit immédiatement les données d'un annonce. Le problème, c'est qu'il y a parfois la ligne "livraison possible" qui s'immice dans les les lignes, ce qui rend la suppression de l'annonce complète (c'est à dire toutes les lignes d'une annonce "vendue" ou "en cours d'achat") complexe, car il faut aussi déterminer si "livraison possible" fait partie de cette annonce (pour pouvoir compter le nombre de cellules à supprimer).

Actuellement, je fais ça "à la main" sur plusieurs centaines n'annonces dans différents registres, d'où ma quête d'automatisation qui me simplifierait la tâche.

Merci

Bonjour,

Veuillez m'excuser pour ma réponse tardive, mais mon PC est tombé en panne et il m'a fallu le réinitialiser entièrement.

Voici le code pour supprimer tous les mots "Star" et les 2 cellules au-dessous.

Sub Supprimer_Star()
    Dim Sh As Worksheet
    Dim Plage As String, Deb As String
    Dim x As Object
    Application.ScreenUpdating = False
    Set Sh = Sheets("LBC")
    Plage = Sh.Range("A1").CurrentRegion.Address
Recherche:
    With Sh.Range(Plage)
        Set x = .Find("Star", lookat:=xlWhole)
        If Err.Number = 0 Then
            If Not x Is Nothing Then
                Range(Sh.Cells(x.Row, x.Column), Sh.Cells(x.Row + 2, x.Column)).Delete
                On Error Resume Next
                Set x = .FindNext(x)
                If Err.Number <> 0 Then
                    On Error GoTo 0
                    GoTo Recherche
                End If
            End If
        End If
    End With
End Sub

Cdlt

Merci

Du coup, je me demande à quoi servait la variable Deb (qui est aussi déclarée ici) dans la version précédente où figurait d'ailleurs cette ligne

Loop While Not x Is Nothing And x.Address <> Deb

c'est une boucle tant que le script ne trouve pas "Star" et que la dernière cellule trouvée est différente de la première qui a initialisé Deb ?

(Dans cette seconde proposition de macro, Deb n'est plus utilisé)

Oui j'ai oublié de supprimer la variable.

Si tout cela vous convient, veuillez passer le sujet en "Résolu".

Cdlt

Parfait

Dois-je créer un autre sujet pour les autres "fonctionnalités" que j'évoquais hier (pour rappel ci-dessous) ?

Il reste maintenant à "éclaircir" le reste, c'est à dire:

1) a chaque fois que le copier coller a "soudé" la date à l'adresse comme par exemple "Cagnes-sur-Mer 0680030/01/2024", scinder les deux (même s'ils sont sur la même ligne). Il y a aussi la même chose avec "hier" ou "aujourd'hui" ou encore "xxxxxx dernier à HH:MM" (xxxxxx étant le nom du jour de la semaine). Tant qu'à faire, si je comprends le principe de scission adresse / date, je peux faire les "détails" par moi-même.

2) le mot "vendu" ou "achat en cours" suit immédiatement les données d'un annonce. Le problème, c'est qu'il y a parfois la ligne "livraison possible" qui s'immice dans les les lignes, ce qui rend la suppression de l'annonce complète (c'est à dire toutes les lignes d'une annonce "vendue" ou "en cours d'achat") complexe, car il faut aussi déterminer si "livraison possible" fait partie de cette annonce (pour pouvoir compter le nombre de cellules à supprimer).

Actuellement, je fais ça "à la main" sur plusieurs centaines n'annonces dans différents registres, d'où ma quête d'automatisation qui me simplifierait la tâche.

Bonsoir,

Dans le fichier joint, je n'ai traité que la question1, le résultat n'est pas parfait (il y a des scissions là où il ne faudrait pas, notamment certains codes postaux suivis d'une date).

A la fin du code , il y a une partie qui corrige quelques anomalies, si vous en trouvez d'autres, vous pourrez aisément les ajouter .

Pour la 2ème question, je 'ai pas le temps de regarder pour le moment

Cdlt

merci déjà pour ça

Je suis conscient de la difficulté à traiter ces "copier-coller" qui se traduisent par des tableaux anarchiques, mais je ne sais pas faire autrement.

Donc merci est un mot modeste pour ce travail accompli

Dans la macro "Supprimer star", la commande suivante :

Range(Sh.Cells(x.Row, x.Column), Sh.Cells(x.Row + 2, x.Column)).Delete

Est censée supprimer la cellule avec "star" et les deux suivantes (dans le sens de la colonne, donc verticalement). En pratique, elle supprime les deux à sa droite.

Pourtant "row" est bel et bien un rang dans le sens vertical ?

Bonjour,

Si l'on doit supprimer la cellule contenant "Star" ainsi que les 2 autres cellules à sa droite, alors c'est ceci:

Range(Sh.Cells(x.Row, x.Column), Sh.Cells(x.Row , x.Column)+ 2).Delete

Si la solution proposée vous convient, veuillez passer le sujet en "Résolu"

Cdlt

Je viens de comprendre ce qui se passe

La syntaxe de votre dernière proposition comporte une petite coquille (emplacement de la parenthèse)

 Range(Sh.Cells(x.Row, x.Column), Sh.Cells(x.Row, x.Column + 2)).Delete

Mais la précédente n'a pas le résultat escompté : en effet, les cellules sont bel et bien supprimées, mais cela décale les cellules horizontalement au lieu de verticalement.

Il m'a suffit de rajouter le shift up pour que ça fonctionne

Range(Sh.Cells(x.Row, x.Column), Sh.Cells(x.Row + 2, x.Column)).Delete Shift:=xlUp

Le reste du script comporte effectivement des choses que je dois encore travailler pour que ça marche, mais maintenant que j'ai compris le principe, je vais essayer de résoudre les autres demandes en me creusant un peu les méninges. Merci