Большой диапазон разделенных клеток

Question

Я хочу использовать следующий код:

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

Но я могу 'не заставить его работать.

У кого-нибудь есть идеи, где проблема?

Спасибо за ваш вклад.

Answer 1

Кажется, это работает:

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

Answer 2

Вот как можно выбрать ячейки, но ваш код для фактического изменения значения нуждается в игре с

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