求将代码修改为指定范围内有效

cqz2022

1. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   
2. If IsNumeric(Application.Selection) Or Target = "" Then: Application.Selection = Application.Selection + 1
   
3. End Sub

复制代码

上面代码可以实现 双击单元后这个单元的数值+1

目前是对全表有效，
想调整为指定范围内有效，这里的指定范围可以是不连续的
如(B1:C260,O2:O,Z2:AZ365)

谢谢

gwjkkkkk

请参考图片。。。

gwjkkkkk

请参考附件。。。

fzxba

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Intersect(Target, Range("B1:C20,E2:F20,H2:I20")) Is Nothing Then
    If IsNumeric(Application.Selection) Or Target = "" Then: Application.Selection = Application.Selection + 1
    Cancel = True
  End If
End Sub

huarong7984

gwjkkkkk 发表于 2024-2-16 09:23
请参考图片。。。

此方法，可用于单位选票统计！免得画“正”字统计。

准提部林

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set v = Intersect(Target, Range("B1:C20,E2:F20,H2:I20"))
If v Is Nothing Then Exit Sub
If IsNumeric(v & "") Then Target = v + 1: Cancel = True
End Sub