大范围的分离细胞

时间:2019-01-03 15:11:07

标签: excel vba

我想使用以下代码:

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)'

但是我无法正常工作。

有人知道问题出在哪里吗?

感谢您的输入。

2 个答案:

答案 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