Effacement conditionné sur une colonne.

ggeo · 1 Juillet 2008

Bonjour,

Le code suivant permet d'effacer le contenu d'une cellule lorsque celle qui la précède, sur la même rangée, est égale à 0.

Dim flag As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
If flag = True Then Exit Sub
flag = True
If Range("N5") = 0 Then
Range("O5").Select
ActiveCell.FormulaR1C1 = ""
End If
If Range("N6") = 0 Then
Range("O6").Select
ActiveCell.FormulaR1C1 = ""
End If
If Range("N7") = 0 Then
Range("O7").Select
ActiveCell.FormulaR1C1 = ""
End If
flag = False
End Sub

Cela est très bien lorsque cela concerne une ou quelques cellules, mais au dela ....

Ma question est donc: Est-il possible d'adapter le code pour agir sur une colonne ?
A noter que le code cité avait déja été adapté par JP14.

Remerciements anticipés et
Bonne soirée.

GCFRG · 2 Juillet 2008

Re : Effacement conditionné sur une colonne.

salut ggeo, 1 piste

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call effacer
End Sub

Private Sub effacer()
Dim i As Long
Application.Calculation = xlCalculationManual
With Sheets("feuil1") ' a adapter a ton cas
If .Cells(5, 14).Value = 0 Then
For i = 5 To .Range("o" & .Rows.Count).End(xlDown).Row - 1 ' a adapter
.Cells(i, 15).Value = ""
If .Cells(i, 14).Value = "" Then Exit Sub
Next i
End If
End With
Application.Calculation = xlCalculationAutomatic
End Sub

a tester et peut être à adapter

Gilbert

Staple1600 · 2 Juillet 2008

Re : Effacement conditionné sur une colonne.

Bonsoir

Si j'ai bien compris

Code:

Sub test()
Dim Z As Range
Dim C As Range
Application.ScreenUpdating = False
Set Z = [A1].CurrentRegion
For Each C In Z
If Len(C) = 1 And C.Value = 0 And C.Column > 1 Then
C.Offset(0, -1).ClearContents
End If
Next C
Application.ScreenUpdating = True
End Sub

ggeo · 2 Juillet 2008

Re : Effacement conditionné sur une colonne.

Bonjour,

Merci GCFRG, Merci Staple 1600.
J'ai retenu le code de Staple 1600 que j'ai adapté à ma feuille.

Bonne journée.

Effacement conditionné sur une colonne.

ggeo

XLDnaute Nouveau

GCFRG

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

ggeo

XLDnaute Nouveau

Discussions similaires