我想使用以下代码:
Private Sub Worksheet_Change(ByVal target As Range)
On Error Resume Next
If Intersect(target, Range("??")) Is Nothing Then GoTo Einde
If IsEmpty(target) Then GoTo Einde
If Hour(target.Value) <> 0 Or Minute(target.Value) <> 0 Then GoTo Einde
Application.EnableEvents = False
If Int(target.Value / 100) < 0.1 Then
target = "00:" & target.Value
Else
target = Int(target.Value / 100) & ":" & Right(target.Value, 2)
End If
Application.EnableEvents = True
ActiveSheet.Calculate
End Sub
第三行代码中的两个问号必须在以下范围内:
Dim aRng, bRng, cRng, dRng, uRng As Range
Set aRng = Range("B5,B7,B9,B11,B13,B15,B17,B19,B21,B26,B28,B30,B32,B34,B36,B38,B40,B42,B47,B49,B51,B53,B55,B57,B59,B61,B63,B68,B70,B72,B74,B76,B78,B80,B82,B84,B89,B91,B93,B95,B97,B99,B101,B103,B105,B110,B112,B114,B116,B118,B120,B122,B124,B126,B131,B133,B135,B137,B139,B141,B143,B145,B147")
Set bRng = Range("F5,F7,F9,F11,F13,F15,F17,F19,F21,F26,F28,F30,F32,F34,F36,F38,F40,F42,F47,F49,F51,F53,F55,F57,F59,F61,F63,F68,F70,F72,F74,F76,F78,F80,F82,F84,F89,F91,F93,F95,F97,F99,F101,F103,F105,F110,F112,F114,F116,F118,F120,F122,F124,F126,F131,F133,F135,F137,F139,F141,F143,F145,F147")
Set cRng = Range("J5,J7,J9,J11,J13,J15,J17,J19,J21,J26,J28,J30,J32,J34,J36,J38,J40,J42,J47,J49,J51,J53,J55,J57,J59,J61,J63,J68,J70,J72,J74,J76,J78,J80,J82,J84,J89,J91,J93,J95,J97,J99,J101,J103,J105,J110,J112,J114,J116,J118,J120,J122,J124,J126,J131,J133,J135,J137,J139,J141,J143,J145,J147")
Set dRng = Range("N5,N7,N9,N11,N13,N15,N17,N19,N21,N26,N28,N30,N32,N34,N36,N38,N40,N42,N47,N49,N51,N53,N55,N57,N59,N61,N63,N68,N70,N72,N74,N76,N78,N80,N82,N84,N89,N91,N93,N95,N97,N99,N101,N103,N105,N110,N112,N114,N116,N118,N120,N122,N124,N126,N131,N133,N135,N137,N139,N141,N143,N145,N147")
Set uRng = Union(aRng, bRng, cRng, dRng)'
但是我无法正常工作。
有人知道问题出在哪里吗?
感谢您的输入。
答案 0 :(得分:1)
这里是选择单元格的方法,但是实际上需要更改值的代码需要使用
Private Sub Worksheet_Change(ByVal target As Range)
If IsEmpty(target) Then
'do nothing
Else
Select Case target.Column
Case 2, 5, 9, 14
Select Case target.Row
Case 5, 7, 9, 11, 13, 15, 17, 19, 21, 26, 28, 30, 32, 34, 36, 38, 40, 42, 47, 49, 51, 53, 55, 57, 59, 61, 63, 68, 70, 72, 74, 76, 78, 80, 82, 84, 89, 91, 93, 95, 97, 99, 101, 103, 105, 110, 112, 114, 116, 118, 120, 122, 124, 126, 131, 133, 135, 137, 139, 141, 143, 145, 147
'these are the cells you want
End Select
Case Else
'do nothing
End Select
End If
End Sub
答案 1 :(得分:0)
这似乎有效:
Private Sub Worksheet_Change(ByVal target As Range)
'invoeren van tijd in gehele getallen
If IsEmpty(target) Then
'do nothing
Else
Select Case target.Column
Case 2, 6, 10, 14
Select Case target.Row
Case 5, 7, 9, 11, 13, 15, 17, 19, 21, 26, 28, 30, 32, 34, 36, 38, 40, 42, 47, 49, 51, 53, 55, 57, 59, 61, 63, 68, 70, 72, 74, 76, 78, 80, 82, 84, 89, 91, 93, 95, 97, 99, 101, 103, 105, 110, 112, 114, 116, 118, 120, 122, 124, 126, 131, 133, 135, 137, 139, 141, 143, 145, 147
'these are the cells you want
End Select
On Error Resume Next
If Hour(target.Value) <> 0 Or Minute(target.Value) <> 0 Then GoTo Einde
Application.EnableEvents = False
If Int(target.Value / 100) < 0.1 Then
target = "00:" & target.Value
Else
target = Int(target.Value / 100) & ":" & Right(target.Value, 2)
End If
Application.EnableEvents = True
Case Else
'do nothing
End Select
End If
Einde:
ActiveSheet.Calculate
End Sub