Option
Explicit
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
arrA = Split(
"W266:W268,X266:X268,Y266:Y268,W271:W273,X271:X273,Y271:Y273,W276:W278,X276:X278,Y276:Y278,W281:W286,X281:X286,Y281:Y286,W288:W291,X288:X291,Y288:Y291"
,
","
)
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
Doit target
Application.EnableEvents =
True
Cancel =
True
Exit
Sub
End
If
End
Sub
Private
Sub
Doit(target)
Dim
c
As
Range
Set
c = target
If
VarType(c.Value) = 5
Then
Select
Case
Int(c.Value)
Case
Is
< 1, 5
c.Value = 1
Case
Else
c.Value = c.Value + 1
End
Select
Else
c.Value = 1
End
If
End
Sub