Norsk møteplass for freakere av alle slag

NAPse

I see you...

380

18. oktober 2019

Jeg er litt usikker på hva du er ute etter.
Dersom jeg ikke er helt på viddene er du ute etter noe slikt(?):

Dette er hvertfall løst med dette VBA-scriptet som er slengt sammen litt tankeløst. Det kan nok løses mye bedre.

Kode

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range

' Cellene vi ser etter oppdatering av
    Set KeyCells = Range("E9:H47")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

'     Display a message when one of the designated cells has been changed.
        
'       Ved oppdatering av kol. E
        If Target.Column = 5 And Target.Value <> "" Then
            Cells(Target.Row, Target.Column + 1).ClearContents
            Cells(Target.Row, Target.Column + 2).ClearContents
            Cells(Target.Row, Target.Column + 3).ClearContents
            
'        Ved oppdatering av kol. F
        ElseIf Target.Column = 6 And Target.Value <> "" Then
            Cells(Target.Row, Target.Column - 1).ClearContents
            Cells(Target.Row, Target.Column + 1).ClearContents
            Cells(Target.Row, Target.Column + 2).ClearContents
            
'       Ved oppdatering av kol. G
        ElseIf Target.Column = 7 And Target.Value <> "" Then
            Cells(Target.Row, Target.Column - 2).ClearContents
            Cells(Target.Row, Target.Column - 1).ClearContents
            Cells(Target.Row, Target.Column + 1).ClearContents
            
'       Ved oppdatering av kol. H
        ElseIf Target.Column = 8 And Target.Value <> "" Then
            Cells(Target.Row, Target.Column - 1).ClearContents
            Cells(Target.Row, Target.Column - 2).ClearContents
            Cells(Target.Row, Target.Column - 3).ClearContents
        End If
    End If
End Sub

Modifisert fra dette eksempelet.