|
Ups - geht ja auch
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim arrA() As String, x
Dim rngSh1 As Range, c As Range
If Target.Count > 1 Then Exit Sub
' Shaft 1_regular
arrA = Split("P243:P245,R243:R245,U243:U245,P248:P250,R248:R250,U248:U250,P253:P255,R253:R255,U253:U255,P258:P259,R258:R259,U258:U259,P261:P263,R261:R263,U261:U263", ",")
For x = LBound(arrA) To UBound(arrA)
If rngSh1 Is Nothing Then
Set rngSh1 = Range(arrA(x))
Else
Set rngSh1 = Union(rngSh1, Range(arrA(x)))
End If
Next x
If Not Intersect(rngSh1, Target) Is Nothing Then
Application.EnableEvents = False
Target.Value = Target.Value + 1
Application.EnableEvents = True
Cancel = True
Exit Sub
End If
'Shaft 2_regular
'
'
'
End Sub
|