XL 2010 recherche cellules non vide et vider les cellules d'une plage. en boucle

[ccia]

Bonjour le Forum,
j'ai commencé une macro (voir module 1) du fichier.

je cherche à faire :
dans la colonne O5 à Ox ; je cherche la première cellule non vide puis je vide dans la ligne de la cellule trouvé de Ei à Ni
"jusque la tous semble bon"
puis en boucle
je continu à rechercher les cellules non vide et à chaque fois vider la ligne trouvé
dés que l'on arrive à la dernière cellule non vide je passe dans le même principe, sur une recherche dans la colonne W5 à Wx,
et efface les données des lignes trouvées entre P & W

merci d'avance et bonne journée

 

[sylvanu]

Bonjour Ccia,
D'après ce que j'ai compris, un essai en PJ avec :

Sub Efface()
    Dim L%: Application.ScreenUpdating = False
    For L = 5 To Range("A65500").End(xlUp).Row
        If Cells(L, "O") <> "" Then Range("E" & L & ":N" & L).ClearContents
        If Cells(L, "W") <> "" Then Range("P" & L & ":V" & L).ClearContents
    Next L
End Sub

J'ai supposé que "P & W" était faux, mais dans la même logique que le 1er point j'ai interprété : "P & V"

 

[ccia]

Bonjour Ccia,
D'après ce que j'ai compris, un essai en PJ avec :

Sub Efface()
    Dim L%: Application.ScreenUpdating = False
    For L = 5 To Range("A65500").End(xlUp).Row
        If Cells(L, "O") <> "" Then Range("E" & L & ":N" & L).ClearContents
        If Cells(L, "W") <> "" Then Range("P" & L & ":V" & L).ClearContents
    Next L
End Sub

J'ai supposé que "P & W" était faux, mais dans la même logique que le 1er point j'ai interprété : "P & V"

Merci Syvanu pour ta réponse aussi rapide
c'est exactement ce que je voulais.
de mon coté j'étais parti sur des complications..

Bonne journée

 

[Hasco]

bonjour,

Une solution sans boucle :

Sub valnum()
    Dim lastRow As Long
    '
    ' Ligne de la dernière cellule
    With Range("A4").CurrentRegion
        lastRow = .Cells(.Cells.Count).Row
    End With
    '
    ' SpecialCells lèvera une erreur si aucune cellule ne correspond
    On Error Resume Next
    Intersect(Columns("E:N"), Range("O5:O" & lastRow).SpecialCells(xlCellTypeConstants, 23)).ClearContents
    Intersect(Columns("P:V"), Range("W5:W" & lastRow).SpecialCells(xlCellTypeConstants, 23)).ClearContents
    On Error GoTo 0
End Sub

Cordialement

 

[ccia]

bonjour,

Une solution sans boucle :

Sub valnum()
    Dim lastRow As Long
    '
    ' Ligne de la dernière cellule
    With Range("A4").CurrentRegion
        lastRow = .Cells(.Cells.Count).Row
    End With
    '
    ' SpecialCells lèvera une erreur si aucune cellule ne correspond
    On Error Resume Next
    Intersect(Columns("E:N"), Range("O5:O" & lastRow).SpecialCells(xlCellTypeConstants, 23)).ClearContents
    Intersect(Columns("P:V"), Range("W5:W" & lastRow).SpecialCells(xlCellTypeConstants, 23)).ClearContents
    On Error GoTo 0
End Sub

Cordialement

Bonjour Hasco,

merci pour ta réponse, pour l'instant j'ai retenu la proposition de Sylvanu,

Votre approche est différente, mais plus complète.....
par contre j'ai essayé le fichier joint et ca n'a pas l'air de fonctionner

Cordialement

 

[Hasco]

Re,

Oui excusez-moi. Il semble que je n'ai pas enregistré les dernières modifications.

Voici qui est fait.

Sub valnum()
    Dim lastRow As Long
    '
    ' Ligne de la dernière cellule
    With Range("A4").CurrentRegion
        lastRow = .Cells(.Cells.Count).Row
    End With
    '
    ' SpecialCells lèvera une erreur si aucune cellule ne correspond
    On Error Resume Next
    Intersect(Columns("E:N"), Range("O5:O" & lastRow).SpecialCells(xlCellTypeConstants, 23).EntireRow).ClearContents
    Intersect(Columns("P:V"), Range("W5:W" & lastRow).SpecialCells(xlCellTypeConstants, 23).EntireRow).ClearContents
    On Error GoTo 0
End Sub

cordialement

 

[ccia]

Re,

Oui excusez-moi. Il semble que je n'ai pas enregistré les dernières modifications.

Voici qui est fait.

Sub valnum()
    Dim lastRow As Long
    '
    ' Ligne de la dernière cellule
    With Range("A4").CurrentRegion
        lastRow = .Cells(.Cells.Count).Row
    End With
    '
    ' SpecialCells lèvera une erreur si aucune cellule ne correspond
    On Error Resume Next
    Intersect(Columns("E:N"), Range("O5:O" & lastRow).SpecialCells(xlCellTypeConstants, 23).EntireRow).ClearContents
    Intersect(Columns("P:V"), Range("W5:W" & lastRow).SpecialCells(xlCellTypeConstants, 23).EntireRow).ClearContents
    On Error GoTo 0
End Sub

cordialement

Bonjour Hasco,
oui effectivement cela fonctionne très bien. Je vois que j'ai à faire à un grand spécialiste du VBA
Ton code est plus complexe et dépasse de loin mes connaissances en VBA
je vais maintenant l'étudier et le mettre en fonction
oui j'aime bien connaitre les codes car si je dois effectuer une modification je sais quoi changer

a bientôt sur le forum
sincères salutations

 

[soan]

Bonjour CCIA,

CCIA = Computer and Communication Industry Association

ouf ! j'ai eu peur ! j'ai cru que la CIA avait débarqué sur XLD !

à part ça, quand donc la CCIA va rejoindre les GAFAM ?

soan

 

[ccia]

Bonjour CCIA,

CCIA = Computer and Communication Industry Association

ouf ! j'ai eu peur ! j'ai cru que la CIA avait débarqué sur XLD !

à part ça, quand donc la CCIA va rejoindre les GAFFAM ?

soan

super trouvaille

en fait "cci" correspondes à 3 lettres incluse dans mon nom
et le "a" est la première lettre de mon prénom

un peu novice dans les forum, c'est quoi les GAFFAM ?

Antoine

 

[soan]

Bonjour Antoine,

oh ! j'viens d'voir que j'avais mis 2 « F » au lieu d'un seul ! (j'viens d'corriger mon post #8)​

c'est donc "GAFAM" ; voir ce lien. (clique sur le lien bleu)

soan

 

[ccia]

Bonjour Antoine,

oh ! j'viens d'voir que j'avais mis 2 « F » au lieu d'un seul !

c'est donc "GAFAM" ; voir ce lien. (clique sur le lien bleu)

soan

et oui bien sur les fameux GAFA (anciennement)

 

[soan]

exact : y'avait pas le M, au début ; ça a été ajouté après.