|
Ergo
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
' Shaft 1_regular_tolerance
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
|