将日期/时间验证添加到Excel的单元格

Question

我有一个我创建的工作时间表，我想在那里放置一些代码来验证条目是正确的时间格式而不是文本。

我已完成代码的基本部分，但我在搜索各种单元格时遇到了一些困难。不幸的是，单元格只是一个大的列表，或者它很容易让我的代码工作。我开始创建多个范围，我打算创建一些for语句循环，但我认为必须有一个更简单的方法。我是这个网站的新手，所以我无法附上日程表的图像。您可以在代码中看到我的范围内的各种单元格。

任何帮助都将不胜感激。

Private Sub Worksheet_Change(ByVal target As Range)

    Dim cel As Range, targ As Range
    Dim v As Variant
    Dim DateRng As Range
    Dim Emp1a As Range, Emp1b As Range
    Dim Emp2a As Range, Emp2b As Range
    Dim Emp3a As Range, Emp3b As Range
    Dim Emp4a As Range, Emp4b As Range
    Dim Emp5a As Range, Emp5b As Range
    Dim Emp6a As Range, Emp6b As Range
    Dim Emp7a As Range, Emp7b As Range
    Dim Emp8a As Range, Emp8b As Range
    Dim Emp9a As Range, Emp9b As Range
    Dim Emp10a As Range, Emp10b As Range
    Dim Emp11a As Range, Emp11b As Range
    Dim Emp12a As Range, Emp12b As Range
    Dim Emp13a As Range, Emp13b As Range
    Dim Emp14a As Range, Emp14b As Range
    Dim Emp15a As Range, Emp15b As Range
    Dim Emp16a As Range, Emp16b As Range
    Dim Emp17a As Range, Emp17b As Range
    Dim Emp18a As Range, Emp18b As Range
    Dim Emp19a As Range, Emp19b As Range
    Dim Emp20a As Range, Emp20b As Range
    Dim Emp21a As Range, Emp21b As Range
    Dim Emp22a As Range, Emp22b As Range
    Dim Emp23a As Range, Emp23b As Range
    Dim Emp24a As Range, Emp24b As Range
    Dim Emp25a As Range, Emp25b As Range

    If target.Rows.Count >= Rows.Count Then Exit Sub


    Set Emp1a = Range("D5,E5,H5,I5,L5,M5,P5,Q5,T5,U5,X5,Y5,AB5,AC5,D6,E6,H6,I6,L6,M6,P6,Q6,T6,U6,X6,Y6,AB6,AC6,D7,E7,H7,I7,L7,M7,P7,Q7,T7,U7,X7,Y7,AB7,AC7")
    Set Emp1b = Range("D9,E9,H9,I9,L9,M9,P9,Q9,T9,U9,X9,Y9,AB9,AC9,D10,E10,H10,I10,L10,M10,P10,Q10,T10,U10,X10,Y10,AB10,AC10,D11,E11,H11,I11,L11,M11,P11,Q11,T11,U11,X11,Y11,AB11,AC11")
    Set Emp2a = Range("D13,E13,H13,I13,L13,M13,P13,Q13,T13,U13,X13,Y13,AB13,AC13,D14,E14,H14,I14,L14,M14,P14,Q14,T14,U14,X14,Y14,AB14,AC14,D15,E15,H15,I15,L15,M15,P15,Q15,T15,U15,X15,Y15,AB15,AC15")
    Set Emp2b = Range("D17,E17,H17,I17,L17,M17,P17,Q17,T17,U17,X17,Y17,AB17,AC17,D18,E18,H18,I18,L18,M18,P18,Q18,T18,U18,X18,Y18,AB18,AC18,D19,E19,H19,I19,L19,M19,P19,Q19,T19,U19,X19,Y19,AB19,AC19")
    Set Emp3a = Range("D25,E25,H25,I25,L25,M25,P25,Q25,T25,U25,X25,Y25,AB25,AC25,D26,E26,H26,I26,L26,M26,P26,Q26,T26,U26,X26,Y26,AB26,AC26,D27,E27,H27,I27,L27,M27,P27,Q27,T27,U27,X27,Y27,AB27,AC27")
    Set Emp3b = Range("D33,E33,H33,I33,L33,M33,P33,Q33,T33,U33,X33,Y33,AB33,AC33,D34,E34,H34,I34,L34,M34,P34,Q34,T34,U34,X34,Y34,AB34,AC34,D35,E35,H35,I35,L35,M35,P35,Q35,T35,U35,X35,Y35,AB35,AC35")

    'Watch these cells for time entries"

    Set Emp1a = Intersect(Emp1a, target) 'Watch these cells for time entries

    If Not Emp1a Is Nothing Then
        Application.EnableEvents = False
        For Each cel In Emp1a.Cells
            If IsNumeric(cel.Value) Then
                If cel.Value > 0 Then
                    If Len(cel.Value) < 7 Then
                        On Error Resume Next
                        v = 0
                        v = TimeValue(Format(cel.Value, "00:0#"))
                        On Error GoTo 0
                        If v = 0 Then
                            cel.Select
                            MsgBox Format(cel.Value, "00:0#") & " is not a permissible time value!"
                            cel.ClearContents
                        End If

                    End If
                Else
                    If cel.Value < 0 Then
                        cel.Select
                        MsgBox cel.Value & " is not a permissible time value"
                        cel.ClearContents
                    End If
                End If
            Else
                cel.Select
                MsgBox cel.Value & " is not a permissible time value"
                cel.ClearContents
            End If
        Next
        Application.EnableEvents = True

    End If
End Sub

Answer 1

我不确定这对您是否足够，但是在输入信息后检查单元格可能更容易阻止它们进入。这是一个两步过程

1. 只需选择单元格＆gt;右键单击＆gt;格式化单元格。＆gt;时间＆gt;选择适当的表示。这只会改变单元格显示信息的方式
2. 选择单元格＆gt;点击＆＃34;数据＆＃34;来自功能区＆gt;点击数据验证＆gt;允许：＆＃34;时间＆＃34; ＆GT;然后您可以使用数据 之间＆＃34; 00:00:00和23:59:59（任何有效日期）或根据需要进行调整

这将做你想要的，但不是以vba的方式。我说为什么重新发明轮子？此外，内置功能经过测试，通常非常强大

-------------------编辑：如何在单元格更改上运行-------------------- - 我强烈推荐这个。 http://www.ozgrid.com/VBA/run-macros-change.htm他们关键在于，而不是在常规＆＃34;模块中输入代码＆＃34;你实际上在工作表中输入代码本身只需双击vb explorer中的工作表名称，就会出现一个输入代码的窗口（我猜这是你的问题）。完全按照原样使用功能标题（您是）

Private Sub Worksheet_Change(ByVal Target As Range)
'do not change the stuff up there ^^^^
    'do whatever you want to the stuff down below vvvv
    MsgBox "You just changed " & Target.Address
End Sub

只要对该特定工作表进行任何更改，它就会自动运行。现在，因为您只希望在更改某些单元格时运行它，所以您可以添加一个范围（也在链接上）。由于你有这么多，如此长的范围，我会让它们全球化以节省时间，特别是如果你需要它们你可能写的其他功能。我也认为它更容易阅读。如果您不知道可以从任何地方访问全局变量。它们在所有函数/ subs中共享。因此，将您的声明移动到工作表模块的顶部（这就是我调用您输入的工作表更改子的位置）。

＆＃13;
＆＃13;
Dim Emp1 As Range, Emp2 As Range
Dim Emp3 As Range, Emp4 As Range
Dim Emp5 As Range, Emp6 As Range
Dim Emp7 As Range, Emp8 As Range
Dim Emp9 As Range, Emp10 As Range
Dim Emp11 As Range, Emp12 As Range
Dim Emp13 As Range, Emp14 As Range
Dim Emp15 As Range, Emp16 As Range
Dim Emp17 As Range, Emp18 As Range
Dim Emp19 As Range, Emp20 As Range
Dim Emp21 As Range, Emp22 As Range
Dim Emp23 As Range, Emp24 As Range
Dim Emp25 As Range

Private Sub Worksheet_Change(ByVal target As Range)
    
    Dim cel As Range
    
    Dim StartTime As Date
    Dim EndTime As Date
    Dim DateRng As Range
    Dim EmpHrs As Range
    Dim Emp1a As Range
    
    Call InitGlobals
    Set EmpHrs = Union(Emp1, Emp2, Emp3, Emp4, Emp5, Emp6, Emp7, Emp8, Emp9, Emp10, Emp11, Emp12, Emp13, Emp14, Emp15, Emp16, Emp17, Emp18, Emp19, Emp20, Emp21, Emp22, Emp23, Emp24, Emp25)
    
    Set EmpHrs = Intersect(EmpHrs, target)
    
    'if the change isn't inside your range just quit
    If Not Intersect(target, EmpHours) Then
        Exit Sub
    End If

    'otherwise it will continue and actually process the change
    For Each cel In EmpHrs
       StartTime = cel.Offset(0, -2)
       EndTime = cel.Offset(0, -1)
       cel = Abs((EndTime - StartTime) - (StartTime > EndTime)) * 24
    Next
        

End Sub

Private Sub InitGlobals()
    Set Emp1 = Range("F5,J5,N5,R5,V5,Z5,AD5,F6,J6,N6,R6,V6,O6,Z6,AD6,F7,J7,N7,R7,V7,AD7,F9,J9,N9,R9,V9,Z9,AD9,F10,J10,N10,R10,V10,Z10,AD10,F11,J11,N11,R11,V11,Z11,AD11")
    Set Emp2 = Range("F13,J13,N13,R13,V13,Z13,AD13,F14,J14,N14,R14,V14,Z14,AD14,F15,J15,N15,R15,V15,Z15,AD15,F17,J17,N17,R17,V17,Z17,AD17,F18,J18,N18,R18,V18,Z18,AD18,F19,J19,N19,R19,V19,Z19,AD19")
    Set Emp3 = Range("F21,J21,N21,R21,V21,Z21,AD21,F22,J22,N22,R22,V22,Z22,AD22,F23,J23,N23,R23,V23,Z23,AD23,F25,J25,N25,R25,V25,Z25,AD25,F26,J26,N26,R26,V26,Z26,AD26,F27,J27,N27,R27,V27,Z27,AD27")
    Set Emp4 = Range("F29,J29,N29,R29,V29,Z29,AD29,F30,J30,N30,R30,V30,Z30,AD30,F31,J31,N31,R31,V31,Z31,AD31,F33,J33,N33,R33,V33,Z33,AD33,F34,J34,N34,R34,V34,Z34,AD34,F35,J35,N35,R35,V35,Z35,AD35")
    Set Emp5 = Range("F37,J37,N37,R37,V37,Z37,AD37,F38,J38,N38,R38,V38,Z38,AD38,F39,J39,N39,R39,V39,Z39,AD39,F41,J41,N41,R41,V41,Z41,AD41,F42,J42,N42,R42,V42,Z42,AD42,F43,J43,N43,R43,V43,Z43,AD43")
    Set Emp6 = Range("F49,J49,N49,R49,V49,Z49,AD49,F50,J50,N50,R50,V50,Z50,AD50,F51,J51,N51,R51,V51,Z51,AD51,F53,J53,N53,R53,V53,Z53,AD53,F54,J54,N54,R54,V54,Z54,AD54,F55,J55,N55,R55,V55,Z55,AD55")
    Set Emp7 = Range("F57,J57,N57,R57,V57,Z57,AD57,F58,J58,N58,R58,V58,Z58,AD58,F59,J59,N59,R59,V59,Z59,AD59,F61,J61,N61,R61,V61,Z61,AD61,F62,J62,N62,R62,V62,Z62,AD62,F63,J63,N63,R63,V63,Z63,AD6")
    Set Emp8 = Range("F65,J65,N65,R65,V65,Z65,AD65,F66,J66,N66,R66,V66,Z66,AD66,F67,J67,N67,R67,V67,Z67,AD67,F69,J69,N69,R69,V69,Z69,AD69,F70,J70,N70,R70,V70,Z70,AD70,F71,J71,N71,R71,V71,Z71,AD71")
    Set Emp9 = Range("F73,J73,N73,R73,V73,Z73,AD73,F74,J74,N74,R74,V74,Z74,AD74,F75,J75,N75,R75,V75,Z75,AD75,F77,J77,N77,R77,V77,Z77,AD77,F78,J78,N78,R78,V78,Z78,AD78,F79,J79,N79,R79,V79,Z79,AD79")
    Set Emp10 = Range("F81,J81,N81,R81,V81,Z81,AD81,F82,J82,N82,R82,V82,Z82,AD82,F83,J83,N83,R83,V83,Z83,AD83,F85,J85,N85,R85,V85,Z85,AD85,F86,J86,N86,R86,V86,Z86,AD86,F87,J87,N87,R87,V87,Z87,AD87")
    Set Emp11 = Range("F93,J93,N93,R93,V93,Z93,AD93,F94,J94,N94,R94,V94,Z94,AD94,F95,J95,N95,R95,V95,Z95,AD95,F97,J97,N97,R97,V97,Z97,AD97,F98,J98,N98,R98,V98,Z98,AD98,F99,J99,N99,R99,V99,Z99,AD99")
    Set Emp12 = Range("F101,J101,N101,R101,V101,Z101,AD101,F102,J102,N102,R102,V102,Z102,AD102,F103,J103,N103,R103,V103,Z103,AD103,F105,J105,N105,R105,V105,Z105,AD105,F106,J106,N106,R106,V106,Z106,AD106,F107,J107,N107,R107,V107,Z107,AD107")
    Set Emp13 = Range("F109,J109,N109,R109,V109,Z109,AD109,F110,J110,N110,R110,V110,Z110,AD110,F111,J111,N111,R111,V111,Z111,AD111,F113,J113,N113,R113,V113,Z113,AD113,F114,J114,N114,R114,V114,Z114,AD114,F115,J115,N115,R115,V115,Z115,AD115")
    Set Emp14 = Range("F117,J117,N117,R117,V117,Z117,AD117,F118,J118,N118,R118,V118,Z118,AD118,F119,J119,N119,R119,V119,Z119,AD119,F121,J121,N121,R121,V121,Z121,AD121,F122,J122,N122,R122,V122,Z122,AD122,F123,J123,N123,R123,V123,Z123,AD123")
    Set Emp15 = Range("F125,J125,N125,R125,V125,Z125,AD125,F126,J126,N126,R126,V126,Z126,AD126,F127,J127,N127,R127,V127,Z127,AD127,F129,J129,N129,R129,V129,Z129,AD129,F130,J130,N130,R130,V130,Z130,AD130,F131,J131,N131,R131,V131,Z131,AD131")
    Set Emp16 = Range("F137,J137,N137,R137,V137,Z137,AD137,F138,J138,N138,R138,V138,Z138,AD138,F139,J139,N139,R139,V139,Z139,AD139,F141,J141,N141,R141,V141,Z141,AD141,F142,J142,N142,R142,V142,Z142,AD142,F143,J143,N143,R143,V143,Z143,AD143")
    Set Emp17 = Range("F145,J145,N145,R145,V145,Z145,AD145,F146,J146,N146,R146,V146,Z146,AD146,F147,J147,N147,R147,V147,Z147,AD147,F149,J149,N149,R149,V149,Z149,AD149,F150,J150,N150,R150,V150,Z150,AD150,F151,J151,N151,R151,V151,Z151,AD151")
    Set Emp18 = Range("F153,J153,N153,R153,V153,Z153,AD153,F154,J154,N154,R154,V154,Z154,AD154,F155,J155,N155,R155,V155,Z155,AD155,F157,J157,N157,R157,V157,Z157,AD157,F158,J158,N158,R158,V158,Z158,AD158,F159,J159,N159,R159,V159,Z159,AD159")
    Set Emp19 = Range("F161,J161,N161,R161,V161,Z161,AD161,F162,J162,N162,R162,V162,Z162,AD162,F163,J163,N163,R163,V163,Z163,AD163,F165,J165,N165,R165,V165,Z165,AD165,F166,J166,N166,R166,V166,Z166,AD166,F167,J167,N167,R167,V167,Z167,AD167")
    Set Emp20 = Range("F169,J169,N169,R169,V169,Z169,AD169,F170,J170,N170,R170,V170,Z170,AD170,F171,J171,N171,R171,V171,Z171,AD171,F173,J173,N173,R173,V173,Z173,AD173,F174,J174,N174,R174,V174,Z174,AD174,F175,J175,N175,R175,V175,Z175,AD175")
    Set Emp21 = Range("F181,J181,N181,R181,V181,Z181,AD181,F182,J182,N182,R182,V182,Z182,AD182,F183,J183,N183,R183,V183,Z183,AD183,F185,J185,N185,R185,V185,Z185,AD185,F186,J186,N186,R186,V186,Z186,AD186,F187,J187,N187,R187,V187,Z187,AD187")
    Set Emp22 = Range("F189,J189,N189,R189,V189,Z189,AD189,F190,J190,N190,R190,V190,Z190,AD190,F191,J191,N191,R191,V191,Z191,AD191,F193,J193,N193,R193,V193,Z193,AD193,F194,J194,N194,R194,V194,Z194,AD194,F195,J195,N195,R195,V195,Z195,AD195")
    Set Emp23 = Range("F197,J197,N197,R197,V197,Z197,AD197,F198,J198,N198,R198,V198,Z198,AD198,F199,J199,N199,R199,V199,Z199,AD199,F201,J201,N201,R201,V201,Z201,AD201,F202,J202,N202,R202,V202,Z202,AD202,F203,J203,N203,R203,V203,Z203,AD203")
    Set Emp24 = Range("F205,J205,N205,R205,V205,Z205,AD205,F206,J206,N206,R206,V206,Z206,AD206,F207,J207,N207,R207,V207,Z207,AD207,F209,J209,N209,R209,V209,Z209,AD209,F210,J210,N210,R210,V210,Z210,AD210,F211,J211,N211,R211,V211,Z211,AD211")
    Set Emp25 = Range("F213,J213,N213,R213,V213,Z213,AD213,F214,J214,N214,R214,V214,Z214,AD214,F215,J215,N215,R215,V215,Z215,AD215,F217,J217,N217,R217,V217,Z217,AD217,F218,J218,N218,R218,V218,Z218,AD218,F219,J219,N219,R219,V219,Z219,AD219")

End Sub
＆＃13;
＆＃13;
＆＃13;

最重要的是我添加了这个    If Not Intersect(target, EmpHours) Then Exit Sub End If

你朝着正确的方向前进，虽然基本上只是说如果细胞不在该范围内退出该潜水艇。希望有所帮助

Answer 2

您可以使用VBA以编程方式将验证对象添加到单个单元格或整个范围（例如“A1：A10”），如以下代码段所示：

Sub AddTimeValidation()

With Range("A1:A10").Validation
 .Add Type:=xlValidateTime, _
 AlertStyle:=xlValidAlertStop, _
 Operator:=xlBetween, Formula1:="0:00:00", Formula2:="23:59:59"
 .InputTitle = "Time"
 .ErrorTitle = "Time"
 .InputMessage = "Enter a Valid Time"
 .ErrorMessage = "You must enter a Enter a Valid Time"
End With

End Sub

此外，您可以手动添加此验证（详细说明请参见：http://office.microsoft.com/en-001/excel-help/apply-data-validation-to-cells-HP010072600.aspx）。

希望这会有所帮助。 亲切的问候，

Answer 3

我能够对我的日期使用数据验证。 另外，我能够让我的代码按照我想要的方式在命令按钮中运行。这是计算每个时间范围的小时数。

但是现在我想让我的代码作为一个改变事件。以下是我的所有代码

命令按钮代码

Command Button Code

    Private Sub CommandButton1_Click()
Dim StartTime As Date
Dim EndTime As Date
Dim DateRng As Range
Dim EmpHrs As Range
Dim Emp1 As Range, Emp2 As Range
Dim Emp3 As Range, Emp4 As Range
Dim Emp5 As Range, Emp6 As Range
Dim Emp7 As Range, Emp8 As Range
Dim Emp9 As Range, Emp10 As Range
Dim Emp11 As Range, Emp12 As Range
Dim Emp13 As Range, Emp14 As Range
Dim Emp15 As Range, Emp16 As Range
Dim Emp17 As Range, Emp18 As Range
Dim Emp19 As Range, Emp20 As Range
Dim Emp21 As Range, Emp22 As Range
Dim Emp23 As Range, Emp24 As Range
Dim Emp25 As Range

Set Emp1 = Range("F5,J5,N5,R5,V5,Z5,AD5,F6,J6,N6,R6,V6,O6,Z6,AD6,F7,J7,N7,R7,V7,AD7,F9,J9,N9,R9,V9,Z9,AD9,F10,J10,N10,R10,V10,Z10,AD10,F11,J11,N11,R11,V11,Z11,AD11")
Set Emp2 = Range("F13,J13,N13,R13,V13,Z13,AD13,F14,J14,N14,R14,V14,Z14,AD14,F15,J15,N15,R15,V15,Z15,AD15,F17,J17,N17,R17,V17,Z17,AD17,F18,J18,N18,R18,V18,Z18,AD18,F19,J19,N19,R19,V19,Z19,AD19")
Set Emp3 = Range("F21,J21,N21,R21,V21,Z21,AD21,F22,J22,N22,R22,V22,Z22,AD22,F23,J23,N23,R23,V23,Z23,AD23,F25,J25,N25,R25,V25,Z25,AD25,F26,J26,N26,R26,V26,Z26,AD26,F27,J27,N27,R27,V27,Z27,AD27")
Set Emp4 = Range("F29,J29,N29,R29,V29,Z29,AD29,F30,J30,N30,R30,V30,Z30,AD30,F31,J31,N31,R31,V31,Z31,AD31,F33,J33,N33,R33,V33,Z33,AD33,F34,J34,N34,R34,V34,Z34,AD34,F35,J35,N35,R35,V35,Z35,AD35")
Set Emp5 = Range("F37,J37,N37,R37,V37,Z37,AD37,F38,J38,N38,R38,V38,Z38,AD38,F39,J39,N39,R39,V39,Z39,AD39,F41,J41,N41,R41,V41,Z41,AD41,F42,J42,N42,R42,V42,Z42,AD42,F43,J43,N43,R43,V43,Z43,AD43")
Set Emp6 = Range("F49,J49,N49,R49,V49,Z49,AD49,F50,J50,N50,R50,V50,Z50,AD50,F51,J51,N51,R51,V51,Z51,AD51,F53,J53,N53,R53,V53,Z53,AD53,F54,J54,N54,R54,V54,Z54,AD54,F55,J55,N55,R55,V55,Z55,AD55")
Set Emp7 = Range("F57,J57,N57,R57,V57,Z57,AD57,F58,J58,N58,R58,V58,Z58,AD58,F59,J59,N59,R59,V59,Z59,AD59,F61,J61,N61,R61,V61,Z61,AD61,F62,J62,N62,R62,V62,Z62,AD62,F63,J63,N63,R63,V63,Z63,AD6")
Set Emp8 = Range("F65,J65,N65,R65,V65,Z65,AD65,F66,J66,N66,R66,V66,Z66,AD66,F67,J67,N67,R67,V67,Z67,AD67,F69,J69,N69,R69,V69,Z69,AD69,F70,J70,N70,R70,V70,Z70,AD70,F71,J71,N71,R71,V71,Z71,AD71")
Set Emp9 = Range("F73,J73,N73,R73,V73,Z73,AD73,F74,J74,N74,R74,V74,Z74,AD74,F75,J75,N75,R75,V75,Z75,AD75,F77,J77,N77,R77,V77,Z77,AD77,F78,J78,N78,R78,V78,Z78,AD78,F79,J79,N79,R79,V79,Z79,AD79")
Set Emp10 = Range("F81,J81,N81,R81,V81,Z81,AD81,F82,J82,N82,R82,V82,Z82,AD82,F83,J83,N83,R83,V83,Z83,AD83,F85,J85,N85,R85,V85,Z85,AD85,F86,J86,N86,R86,V86,Z86,AD86,F87,J87,N87,R87,V87,Z87,AD87")
Set Emp11 = Range("F93,J93,N93,R93,V93,Z93,AD93,F94,J94,N94,R94,V94,Z94,AD94,F95,J95,N95,R95,V95,Z95,AD95,F97,J97,N97,R97,V97,Z97,AD97,F98,J98,N98,R98,V98,Z98,AD98,F99,J99,N99,R99,V99,Z99,AD99")
Set Emp12 = Range("F101,J101,N101,R101,V101,Z101,AD101,F102,J102,N102,R102,V102,Z102,AD102,F103,J103,N103,R103,V103,Z103,AD103,F105,J105,N105,R105,V105,Z105,AD105,F106,J106,N106,R106,V106,Z106,AD106,F107,J107,N107,R107,V107,Z107,AD107")
Set Emp13 = Range("F109,J109,N109,R109,V109,Z109,AD109,F110,J110,N110,R110,V110,Z110,AD110,F111,J111,N111,R111,V111,Z111,AD111,F113,J113,N113,R113,V113,Z113,AD113,F114,J114,N114,R114,V114,Z114,AD114,F115,J115,N115,R115,V115,Z115,AD115")
Set Emp14 = Range("F117,J117,N117,R117,V117,Z117,AD117,F118,J118,N118,R118,V118,Z118,AD118,F119,J119,N119,R119,V119,Z119,AD119,F121,J121,N121,R121,V121,Z121,AD121,F122,J122,N122,R122,V122,Z122,AD122,F123,J123,N123,R123,V123,Z123,AD123")
Set Emp15 = Range("F125,J125,N125,R125,V125,Z125,AD125,F126,J126,N126,R126,V126,Z126,AD126,F127,J127,N127,R127,V127,Z127,AD127,F129,J129,N129,R129,V129,Z129,AD129,F130,J130,N130,R130,V130,Z130,AD130,F131,J131,N131,R131,V131,Z131,AD131")
Set Emp16 = Range("F137,J137,N137,R137,V137,Z137,AD137,F138,J138,N138,R138,V138,Z138,AD138,F139,J139,N139,R139,V139,Z139,AD139,F141,J141,N141,R141,V141,Z141,AD141,F142,J142,N142,R142,V142,Z142,AD142,F143,J143,N143,R143,V143,Z143,AD143")
Set Emp17 = Range("F145,J145,N145,R145,V145,Z145,AD145,F146,J146,N146,R146,V146,Z146,AD146,F147,J147,N147,R147,V147,Z147,AD147,F149,J149,N149,R149,V149,Z149,AD149,F150,J150,N150,R150,V150,Z150,AD150,F151,J151,N151,R151,V151,Z151,AD151")
Set Emp18 = Range("F153,J153,N153,R153,V153,Z153,AD153,F154,J154,N154,R154,V154,Z154,AD154,F155,J155,N155,R155,V155,Z155,AD155,F157,J157,N157,R157,V157,Z157,AD157,F158,J158,N158,R158,V158,Z158,AD158,F159,J159,N159,R159,V159,Z159,AD159")
Set Emp19 = Range("F161,J161,N161,R161,V161,Z161,AD161,F162,J162,N162,R162,V162,Z162,AD162,F163,J163,N163,R163,V163,Z163,AD163,F165,J165,N165,R165,V165,Z165,AD165,F166,J166,N166,R166,V166,Z166,AD166,F167,J167,N167,R167,V167,Z167,AD167")
Set Emp20 = Range("F169,J169,N169,R169,V169,Z169,AD169,F170,J170,N170,R170,V170,Z170,AD170,F171,J171,N171,R171,V171,Z171,AD171,F173,J173,N173,R173,V173,Z173,AD173,F174,J174,N174,R174,V174,Z174,AD174,F175,J175,N175,R175,V175,Z175,AD175")
Set Emp21 = Range("F181,J181,N181,R181,V181,Z181,AD181,F182,J182,N182,R182,V182,Z182,AD182,F183,J183,N183,R183,V183,Z183,AD183,F185,J185,N185,R185,V185,Z185,AD185,F186,J186,N186,R186,V186,Z186,AD186,F187,J187,N187,R187,V187,Z187,AD187")
Set Emp22 = Range("F189,J189,N189,R189,V189,Z189,AD189,F190,J190,N190,R190,V190,Z190,AD190,F191,J191,N191,R191,V191,Z191,AD191,F193,J193,N193,R193,V193,Z193,AD193,F194,J194,N194,R194,V194,Z194,AD194,F195,J195,N195,R195,V195,Z195,AD195")
Set Emp23 = Range("F197,J197,N197,R197,V197,Z197,AD197,F198,J198,N198,R198,V198,Z198,AD198,F199,J199,N199,R199,V199,Z199,AD199,F201,J201,N201,R201,V201,Z201,AD201,F202,J202,N202,R202,V202,Z202,AD202,F203,J203,N203,R203,V203,Z203,AD203")
Set Emp24 = Range("F205,J205,N205,R205,V205,Z205,AD205,F206,J206,N206,R206,V206,Z206,AD206,F207,J207,N207,R207,V207,Z207,AD207,F209,J209,N209,R209,V209,Z209,AD209,F210,J210,N210,R210,V210,Z210,AD210,F211,J211,N211,R211,V211,Z211,AD211")
Set Emp25 = Range("F213,J213,N213,R213,V213,Z213,AD213,F214,J214,N214,R214,V214,Z214,AD214,F215,J215,N215,R215,V215,Z215,AD215,F217,J217,N217,R217,V217,Z217,AD217,F218,J218,N218,R218,V218,Z218,AD218,F219,J219,N219,R219,V219,Z219,AD219")

Set EmpHrs = Union(Emp1, Emp2, Emp3, Emp4, Emp5, Emp6, Emp7, Emp8, Emp9, Emp10, Emp11, Emp12, Emp13, Emp14, Emp15, Emp16, Emp17, Emp18, Emp19, Emp20, Emp21, Emp22, Emp23, Emp24, Emp25)
For Each DateRng In EmpHrs

  
On Error Resume Next
    StartTime = DateRng.Offset(0, -2)
    EndTime = DateRng.Offset(0, -1)
    DateRng = Abs((EndTime - StartTime) - (StartTime > EndTime)) * 24

Next DateRng

   
End Sub

更改活动代码

Private Sub Worksheet_Change(ByVal target As Range)

Dim cel As Range

Dim StartTime As Date
Dim EndTime As Date
Dim DateRng As Range
Dim EmpHrs As Range
Dim Emp1a As Range

Dim Emp1 As Range, Emp2 As Range
Dim Emp3 As Range, Emp4 As Range
Dim Emp5 As Range, Emp6 As Range
Dim Emp7 As Range, Emp8 As Range
Dim Emp9 As Range, Emp10 As Range
Dim Emp11 As Range, Emp12 As Range
Dim Emp13 As Range, Emp14 As Range
Dim Emp15 As Range, Emp16 As Range
Dim Emp17 As Range, Emp18 As Range
Dim Emp19 As Range, Emp20 As Range
Dim Emp21 As Range, Emp22 As Range
Dim Emp23 As Range, Emp24 As Range
Dim Emp25 As Range

Set Emp1 = Range("F5,J5,N5,R5,V5,Z5,AD5,F6,J6,N6,R6,V6,O6,Z6,AD6,F7,J7,N7,R7,V7,AD7,F9,J9,N9,R9,V9,Z9,AD9,F10,J10,N10,R10,V10,Z10,AD10,F11,J11,N11,R11,V11,Z11,AD11")
Set Emp2 = Range("F13,J13,N13,R13,V13,Z13,AD13,F14,J14,N14,R14,V14,Z14,AD14,F15,J15,N15,R15,V15,Z15,AD15,F17,J17,N17,R17,V17,Z17,AD17,F18,J18,N18,R18,V18,Z18,AD18,F19,J19,N19,R19,V19,Z19,AD19")
Set Emp3 = Range("F21,J21,N21,R21,V21,Z21,AD21,F22,J22,N22,R22,V22,Z22,AD22,F23,J23,N23,R23,V23,Z23,AD23,F25,J25,N25,R25,V25,Z25,AD25,F26,J26,N26,R26,V26,Z26,AD26,F27,J27,N27,R27,V27,Z27,AD27")
Set Emp4 = Range("F29,J29,N29,R29,V29,Z29,AD29,F30,J30,N30,R30,V30,Z30,AD30,F31,J31,N31,R31,V31,Z31,AD31,F33,J33,N33,R33,V33,Z33,AD33,F34,J34,N34,R34,V34,Z34,AD34,F35,J35,N35,R35,V35,Z35,AD35")
Set Emp5 = Range("F37,J37,N37,R37,V37,Z37,AD37,F38,J38,N38,R38,V38,Z38,AD38,F39,J39,N39,R39,V39,Z39,AD39,F41,J41,N41,R41,V41,Z41,AD41,F42,J42,N42,R42,V42,Z42,AD42,F43,J43,N43,R43,V43,Z43,AD43")
Set Emp6 = Range("F49,J49,N49,R49,V49,Z49,AD49,F50,J50,N50,R50,V50,Z50,AD50,F51,J51,N51,R51,V51,Z51,AD51,F53,J53,N53,R53,V53,Z53,AD53,F54,J54,N54,R54,V54,Z54,AD54,F55,J55,N55,R55,V55,Z55,AD55")
Set Emp7 = Range("F57,J57,N57,R57,V57,Z57,AD57,F58,J58,N58,R58,V58,Z58,AD58,F59,J59,N59,R59,V59,Z59,AD59,F61,J61,N61,R61,V61,Z61,AD61,F62,J62,N62,R62,V62,Z62,AD62,F63,J63,N63,R63,V63,Z63,AD6")
Set Emp8 = Range("F65,J65,N65,R65,V65,Z65,AD65,F66,J66,N66,R66,V66,Z66,AD66,F67,J67,N67,R67,V67,Z67,AD67,F69,J69,N69,R69,V69,Z69,AD69,F70,J70,N70,R70,V70,Z70,AD70,F71,J71,N71,R71,V71,Z71,AD71")
Set Emp9 = Range("F73,J73,N73,R73,V73,Z73,AD73,F74,J74,N74,R74,V74,Z74,AD74,F75,J75,N75,R75,V75,Z75,AD75,F77,J77,N77,R77,V77,Z77,AD77,F78,J78,N78,R78,V78,Z78,AD78,F79,J79,N79,R79,V79,Z79,AD79")
Set Emp10 = Range("F81,J81,N81,R81,V81,Z81,AD81,F82,J82,N82,R82,V82,Z82,AD82,F83,J83,N83,R83,V83,Z83,AD83,F85,J85,N85,R85,V85,Z85,AD85,F86,J86,N86,R86,V86,Z86,AD86,F87,J87,N87,R87,V87,Z87,AD87")
Set Emp11 = Range("F93,J93,N93,R93,V93,Z93,AD93,F94,J94,N94,R94,V94,Z94,AD94,F95,J95,N95,R95,V95,Z95,AD95,F97,J97,N97,R97,V97,Z97,AD97,F98,J98,N98,R98,V98,Z98,AD98,F99,J99,N99,R99,V99,Z99,AD99")
Set Emp12 = Range("F101,J101,N101,R101,V101,Z101,AD101,F102,J102,N102,R102,V102,Z102,AD102,F103,J103,N103,R103,V103,Z103,AD103,F105,J105,N105,R105,V105,Z105,AD105,F106,J106,N106,R106,V106,Z106,AD106,F107,J107,N107,R107,V107,Z107,AD107")
Set Emp13 = Range("F109,J109,N109,R109,V109,Z109,AD109,F110,J110,N110,R110,V110,Z110,AD110,F111,J111,N111,R111,V111,Z111,AD111,F113,J113,N113,R113,V113,Z113,AD113,F114,J114,N114,R114,V114,Z114,AD114,F115,J115,N115,R115,V115,Z115,AD115")
Set Emp14 = Range("F117,J117,N117,R117,V117,Z117,AD117,F118,J118,N118,R118,V118,Z118,AD118,F119,J119,N119,R119,V119,Z119,AD119,F121,J121,N121,R121,V121,Z121,AD121,F122,J122,N122,R122,V122,Z122,AD122,F123,J123,N123,R123,V123,Z123,AD123")
Set Emp15 = Range("F125,J125,N125,R125,V125,Z125,AD125,F126,J126,N126,R126,V126,Z126,AD126,F127,J127,N127,R127,V127,Z127,AD127,F129,J129,N129,R129,V129,Z129,AD129,F130,J130,N130,R130,V130,Z130,AD130,F131,J131,N131,R131,V131,Z131,AD131")
Set Emp16 = Range("F137,J137,N137,R137,V137,Z137,AD137,F138,J138,N138,R138,V138,Z138,AD138,F139,J139,N139,R139,V139,Z139,AD139,F141,J141,N141,R141,V141,Z141,AD141,F142,J142,N142,R142,V142,Z142,AD142,F143,J143,N143,R143,V143,Z143,AD143")
Set Emp17 = Range("F145,J145,N145,R145,V145,Z145,AD145,F146,J146,N146,R146,V146,Z146,AD146,F147,J147,N147,R147,V147,Z147,AD147,F149,J149,N149,R149,V149,Z149,AD149,F150,J150,N150,R150,V150,Z150,AD150,F151,J151,N151,R151,V151,Z151,AD151")
Set Emp18 = Range("F153,J153,N153,R153,V153,Z153,AD153,F154,J154,N154,R154,V154,Z154,AD154,F155,J155,N155,R155,V155,Z155,AD155,F157,J157,N157,R157,V157,Z157,AD157,F158,J158,N158,R158,V158,Z158,AD158,F159,J159,N159,R159,V159,Z159,AD159")
Set Emp19 = Range("F161,J161,N161,R161,V161,Z161,AD161,F162,J162,N162,R162,V162,Z162,AD162,F163,J163,N163,R163,V163,Z163,AD163,F165,J165,N165,R165,V165,Z165,AD165,F166,J166,N166,R166,V166,Z166,AD166,F167,J167,N167,R167,V167,Z167,AD167")
Set Emp20 = Range("F169,J169,N169,R169,V169,Z169,AD169,F170,J170,N170,R170,V170,Z170,AD170,F171,J171,N171,R171,V171,Z171,AD171,F173,J173,N173,R173,V173,Z173,AD173,F174,J174,N174,R174,V174,Z174,AD174,F175,J175,N175,R175,V175,Z175,AD175")
Set Emp21 = Range("F181,J181,N181,R181,V181,Z181,AD181,F182,J182,N182,R182,V182,Z182,AD182,F183,J183,N183,R183,V183,Z183,AD183,F185,J185,N185,R185,V185,Z185,AD185,F186,J186,N186,R186,V186,Z186,AD186,F187,J187,N187,R187,V187,Z187,AD187")
Set Emp22 = Range("F189,J189,N189,R189,V189,Z189,AD189,F190,J190,N190,R190,V190,Z190,AD190,F191,J191,N191,R191,V191,Z191,AD191,F193,J193,N193,R193,V193,Z193,AD193,F194,J194,N194,R194,V194,Z194,AD194,F195,J195,N195,R195,V195,Z195,AD195")
Set Emp23 = Range("F197,J197,N197,R197,V197,Z197,AD197,F198,J198,N198,R198,V198,Z198,AD198,F199,J199,N199,R199,V199,Z199,AD199,F201,J201,N201,R201,V201,Z201,AD201,F202,J202,N202,R202,V202,Z202,AD202,F203,J203,N203,R203,V203,Z203,AD203")
Set Emp24 = Range("F205,J205,N205,R205,V205,Z205,AD205,F206,J206,N206,R206,V206,Z206,AD206,F207,J207,N207,R207,V207,Z207,AD207,F209,J209,N209,R209,V209,Z209,AD209,F210,J210,N210,R210,V210,Z210,AD210,F211,J211,N211,R211,V211,Z211,AD211")
Set Emp25 = Range("F213,J213,N213,R213,V213,Z213,AD213,F214,J214,N214,R214,V214,Z214,AD214,F215,J215,N215,R215,V215,Z215,AD215,F217,J217,N217,R217,V217,Z217,AD217,F218,J218,N218,R218,V218,Z218,AD218,F219,J219,N219,R219,V219,Z219,AD219")

Set EmpHrs = Union(Emp1, Emp2, Emp3, Emp4, Emp5, Emp6, Emp7, Emp8, Emp9, Emp10, Emp11, Emp12, Emp13, Emp14, Emp15, Emp16, Emp17, Emp18, Emp19, Emp20, Emp21, Emp22, Emp23, Emp24, Emp25)



 
 Set EmpHrs = Intersect(EmpHrs, target)
 
    For Each cel In EmpHrs
       StartTime = cel.Offset(0, -2)
       EndTime = cel.Offset(0, -1)
       cel = Abs((EndTime - StartTime) - (StartTime > EndTime)) * 24
    Next
    
    
'End If
    


End Sub