Cellen vullen en leegmaken

[arvie76]

Hoi Excel deskundige,

Waar denk ik fout.

Ik wil dat zodra de cellen E7 t/m E9 leeg zijn of een waarde groter dan nul de cellen 2 en 3 kolommen verder leeg blijven en zodra en in de range 0 wordt gevuld moet er nvt te komen te staan.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    
    Dim rCell As Range
    Dim rChange As Range
    
    On Error GoTo ErrHandler
    Set rChange = Intersect(Target, Range("E7:E9"))
    If Not rChange Is Nothing Then
        Application.EnableEvents = False
        For Each rCell In rChange
            If rCell > 0 Or <> ""  Then
                With rCell.Offset(0, 2)
                    .ClearContents
                End With
                With rCell.Offset(0, 3)
                    .ClearContents
                End With
             End If
             
             If rCell = 0 Then
                With rCell.Offset(0, 2)
                    .Value = "n.v.t."
                End With
                With rCell.Offset(0, 3)
                    .Value = "n.v.t."
                              
                End With
              Else
                
              End If
        Next
        
    End If

ExitHandler:
    Set rCell = Nothing
    Set rChange = Nothing
    Application.EnableEvents = True
    Exit Sub
ErrHandler:
     Resume ExitHandler

End Sub

 

[Timshel]

Eén ding wat ik eruit haal

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    
    Dim rCell As Range
    Dim rChange As Range
    
    On Error GoTo ErrHandler
    Set rChange = Intersect(Target, Range("E7:E9"))
    If Not rChange Is Nothing Then
        Application.EnableEvents = False
        For Each rCell In rChange
            [COLOR="#FF0000"]If rCell > 0 Or rCell = ""  Then[/COLOR]
                With rCell.Offset(0, 2)
                    .ClearContents
                End With
                With rCell.Offset(0, 3)
                    .ClearContents
                End With
             End If
             
             If rCell = 0 Then
                With rCell.Offset(0, 2)
                    .Value = "n.v.t."
                End With
                With rCell.Offset(0, 3)
                    .Value = "n.v.t."
                              
                End With
              Else
                
              End If
        Next
        
    End If

ExitHandler:
    Set rCell = Nothing
    Set rChange = Nothing
    Application.EnableEvents = True
    Exit Sub
ErrHandler:
     Resume ExitHandler

End Sub

 

[arvie76]

Thnx Timshel

Thnx voor snelle reactie. Heb hem nu helemaal werkend met een kleine aanpassing

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    
    Dim rCell As Range
    Dim rChange As Range
    
    On Error GoTo ErrHandler
    Set rChange = Intersect(Target, Range("E7:E9"))
    If Not rChange Is Nothing Then
        Application.EnableEvents = False
        For Each rCell In rChange
            If rCell > 0 Then
                With rCell.Offset(0, 2)
                    .Value = "Datum vullen"
                End With
                With rCell.Offset(0, 3)
                    .Value = "RSIN vullen"
                End With
             End If
             
             If rCell = 0 Then
                With rCell.Offset(0, 2)
                    .Value = "n.v.t."
                End With
                With rCell.Offset(0, 3)
                    .Value = "n.v.t."
                              
                End With
                
             End If
             
               If rCell = "" Then
               With rCell.Offset(0, 2)
                    .ClearContents
               End With
               With rCell.Offset(0, 3)
                    .ClearContents
                    
               End With
                
                
              Else
                
              End If
        Next
        
    End If

ExitHandler:
    Set rCell = Nothing
    Set rChange = Nothing
    Application.EnableEvents = True
    Exit Sub
ErrHandler:
     Resume ExitHandler

End Sub

 

[Timshel]

Kijk nog eens naar deze geredigeerde versie. Doet hetzelfde maar is korter en eleganter.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim rCell As Range, rChange As Range
    
    Set rChange = Intersect(Target, Range("E7:E9"))
    If Not rChange Is Nothing Then
        For Each rCell In rChange
            Select Case rCell.Value
                Case Is > 0
                    rCell.Offset(, 2).Resize(, 2) = Array("Datum vullen", "RSIN vullen")
                Case Is = ""
                    rCell.Offset(, 2).Resize(, 2).ClearContents
                Case Is = 0
                    rCell.Offset(, 2).Resize(, 2) = Array("n.v.t", "n.v.t.")
            End Select
        Next
    End If
End Sub

 

[edmoor]

Kijk eens naar deze:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Not Intersect(Target, Range("E7:E9")) Is Nothing And Target.Count = 1 Then
        If Len(Target.Value) = 0 Then
            Target.Offset(0, 2).ClearContents
            Target.Offset(0, 3).ClearContents
        Else
            Select Case Target.Value
                Case Is > 0
                    Target.Offset(0, 2).Value = "Datum vullen"
                    Target.Offset(0, 3).Value = "RSIN vullen"
                Case 0
                    Target.Offset(0, 2).Value = "n.v.t."
                    Target.Offset(0, 3).Value = "n.v.t."
            End Select
        End If
    End If
End Sub

 

[arvie76]

Thnx Edmoor & Timshel

Thanks voor jullie feedback. Ik heb hem nu werkt met de tweede optie van Timshel.

Maar ben nu wel nieuwsgierig wat verschil is tussen de aangeboden suggesties van Edmoor en Timshel.

 

[edmoor]

Dat kan je toch zelf zien?
Het komt in principe op hetzelfde neer.
Maar ik vind de For Each overbodig omdat je maar met 1 te controleren cel te maken hebt.
Daarnaast is ook het aanmaken van een object met Set niet nodig en de variabelen ook niet.

 

[Timshel]

Ik heb inderdaad rekening gehouden met de mogelijkheid van target.count > 1, bijvoorbeeld als de gebruiker het hele actieve bereik leegmaakt. Je kunt erover twisten. De belangrijkste les lijkt me het gebruik van Select Case.

 

[edmoor]

Het ging mij om de overbodige For Each, Set en variabelen.

 

[Timshel]

Als je uitgaat van een selectie met meerdere cellen zijn ze niet overbodig.