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

ccia

XLDnaute Nouveau
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
 

Pièces jointes

  • 1 recerche & vide V1.xlsm
    63.3 KB · Affichages: 3
Solution
Bonjour Ccia,
D'après ce que j'ai compris, un essai en PJ avec :
Code:
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"

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Ccia,
D'après ce que j'ai compris, un essai en PJ avec :
Code:
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"
 

Pièces jointes

  • 1 recerche & vide V1.xlsm
    23.7 KB · Affichages: 1

ccia

XLDnaute Nouveau
Bonjour Ccia,
D'après ce que j'ai compris, un essai en PJ avec :
Code:
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

XLDnaute Barbatruc
bonjour,

Une solution sans boucle :
VB:
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
 

Pièces jointes

  • 1 recerche & vide V1.xlsm
    63.3 KB · Affichages: 1

ccia

XLDnaute Nouveau
bonjour,

Une solution sans boucle :
VB:
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

XLDnaute Barbatruc
Re,

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

Voici qui est fait.
VB:
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
 

Pièces jointes

  • 1 recerche & vide V1.xlsm
    66.3 KB · Affichages: 3

ccia

XLDnaute Nouveau
Re,

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

Voici qui est fait.
VB:
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
 

ccia

XLDnaute Nouveau
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
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
299 956
Messages
1 980 368
Membres
207 067
dernier inscrit
Miks57450