Excel 365 VBA小时和分钟格式

我正在处理一个简单的Excel文件和一些工作表，在每个工作表中，我都报告了工作时间和分钟数。我想以313:32的形式显示它，即313小时32分钟，为此，我使用了一种自定义格式

[h]：mm

为了方便很少使用Excel的工作人员，我想创建一些vba代码，这样他们不仅可以插入分钟，还可以插入经典格式

[h]：mm

，这样他们还可以插入小时和分钟的值。 我报告了一些我想要的示例数据。 插入内容->单元格内打印的我想要的内容

• 1->0:01
• 2->0:02
• 3->0:03
• 65->1:05
• 23:33->23:33
• 24:00->24:00
• 24:01->24:01

然后我在

[h]：mm中格式化了每个可以包含时间值的单元格，并编写了这段代码

Public Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo bm_Safe_Exit
    With Sh
        If IsNumeric(Target) = True And Target.NumberFormat = "[h]:mm" Then

            If Int(Target.Value) / Target.Value = 1 Then
                Debug.Print "Integer -> " & Target.Value
                Application.EnableEvents = False
                Target.Value = Target.Value / 1440
                Application.EnableEvents = True
                Exit Sub
            End If

            Debug.Print "Other value -> " & Target.Value
        End If
    End With
bm_Safe_Exit:
    Application.EnableEvents = True
End Sub

代码运行得很好，但当我输入24:00及其倍数48:00、72:00时出错。。。
这是因为单元格的格式是
[h]：mm
，所以在执行vba代码之前24:00变为1

我试图更正代码，有趣的是，当我更正24:00时，24:00仍然是24:00而不是00:24，问题切换到1，变成24:00而不是00:01

我的第一个想法是在单元格格式之前“强制”执行vba代码，但我不知道这是否可行。
我知道这似乎是一个愚蠢的问题，但我真的不知道这是否可能以及如何解决它

任何想法都将受到赞赏
最简单的方法似乎是使用单元格文本（即单元格的显示方式）而不是实际的单元格值。如果它看起来像一个时间（例如，
“[h]：mm”
，
“hh:mm”
，
“hh:mm:ss”
），则使用它相应地添加每个时间部分的值（以避免24:00问题）。否则，如果它是一个数字，假设它是分钟

下面的方法也适用于常规、文本和时间等格式（除非时间以天部分开始，但必要时也可以进一步开发以处理该部分）

Public子工作簿\u SheetChange（ByVal Sh作为对象，ByVal Target作为范围）
错误转到bm_安全出口
将零件标注为字符串，零件（）标注为字符串，总计标注为单个
Application.EnableEvents=False
如果不是IsEmpty（Target）和Target.NumberFormat=“[h]：mm”，则
'更喜欢目标的外观而不是其基础价值
如果InStr（Target.Text，“：”），则
“拆分方式”：“然后将各部分相加，得出十进制值
零件=拆分（Target.Text，“：”）
总数=0
“时间
如果为数字（零件（0）），则
总计=CInt（第（0）部分）/24
如果结束
”“几分钟
如果0
要求：以小时和分钟为单位报告时间，分钟是最低的衡量标准（即：无论报告的时间以小时为单位，部分时间以分钟为单位，即
13天、1小时和32分钟
或
13.06388888889
应显示为
313:32
）
应允许用户以两种不同的方式输入时间：

仅输入分钟：输入的值应为整数（无小数）
输入小时和分钟：输入的值应由表示小时和分钟的两个整数组成，用冒号分隔
：
输入的Excel处理值：

Excel直观地处理单元格中输入值的
数据类型
和
Number.Format
。
当单元格
NumberFormat
为“常规”时，Excel会将输入的值转换为与输入的数据（字符串、双精度、货币、日期等）相关的数据类型，并根据输入值的“格式”更改
NumberFormat
（见下表）


当单元格
NumberFormat
不是常规格式时，Excel将输入的值转换为与单元格格式对应的数据类型，而不对
NumberFormat
进行任何更改（见下表）


因此，不可能知道用户输入的值的格式，除非可以在Excel应用其处理方法之前拦截输入的值

虽然在Excel处理输入的值之前无法截取它们，但我们可以使用
Range.validation属性
为用户输入的值设置验证标准

解决方案：此建议的解决方案使用：


：识别并格式化输入单元格
：向用户传达输入值所需的格式，强制用户以文本形式输入数据
工作簿更改工作簿事件：验证和处理输入的值

建议使用自定义的
样式
来标识和格式化输入单元格，实际上OP使用的是
NumberFormat
来标识输入单元格，但似乎也可能有带有公式或对象的单元格（即汇总表、
数据透视表
等）需要相同的
NumberFormat
。通过仅对输入单元格使用自定义样式，可以轻松地将非输入单元格从流程中排除

允许设置
数字格式
，
字体
，
对齐
，
边框
Public Const pk_StyTmInp As String = "TimeInput"

Private Sub Wbk_Styles_Add_TimeInput()
    
    With ActiveWorkbook.Styles.Add(pk_StyTmInp)
        
        .IncludeNumber = True
        .IncludeFont = True
        .IncludeAlignment = True
        .IncludeBorder = True
        .IncludePatterns = True
        .IncludeProtection = True
    
        .NumberFormat = "[h]:mm"
        .Font.Color = XlRgbColor.rgbBlue
        .HorizontalAlignment = xlGeneral
        .Borders.LineStyle = xlNone
        .Interior.Color = XlRgbColor.rgbPowderBlue
        .Locked = False
        .FormulaHidden = False
    
    End With

End Sub

Private Sub InputRange_Set_Properties(Rng As Range)

Const kFml As String = "=ISTEXT(#CLL)"
Const kTtl As String = "Time as ['M] or ['H:M]"
Const kMsg As String = "Enter time preceded by a apostrophe [']" & vbLf & _
                            "enter M minutes as 'M" & vbLf & _
                            "or H hours and M minutes as 'H:M"  'Change as required
Dim sFml As String
    
    Application.EnableEvents = False
    
    With Rng

        .Style = pk_StyTmInp
        sFml = Replace(kFml, "#CLL", .Cells(1).Address(0, 0))

        With .Validation
            .Delete
            .Add Type:=xlValidateCustom, _
                AlertStyle:=xlValidAlertStop, _
                Operator:=xlBetween, Formula1:=sFml
            .IgnoreBlank = True
            .InCellDropdown = False

            .InputTitle = kTtl
            .InputMessage = kMsg
            .ShowInput = True

            .ErrorTitle = kTtl
            .ErrorMessage = kMsg
            .ShowError = True

    End With: End With

    Application.EnableEvents = True

End Sub

Private Sub InputRange_Set_Properties_TEST()
Dim Rng As Range
    Set Rng = ThisWorkbook.Sheets("TEST").Range("D3:D31")
    Call InputRange_Set_Properties(Rng)
    End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Const kMsg As String = "[ #INP ] is not a valid entry."
Dim blValid As Boolean
Dim vInput As Variant, dOutput As Date
Dim iTime As Integer
    
    Application.EnableEvents = False
    
    With Target

        Rem Validate Input Cell
        If .Cells.Count > 1 Then GoTo EXIT_Pcdr         'Target has multiple cells
        If .Style <> pk_StyTmInp Then GoTo EXIT_Pcdr    'Target Style is not TimeInput
        If .Value = vbNullString Then GoTo EXIT_Pcdr    'Target is empty
        
        Rem Validate & Process Input Value
        vInput = .Value                         'Set Input Value
        Select Case True
        Case Application.IsNumber(vInput):      GoTo EXIT_Pcdr      'NO ACTION NEEDED - Cell value is not a text thus is not an user input
        Case InStr(vInput, ":") > 0:            blValid = InputTime_ƒAsDate(dOutput, vInput)        'Validate & Format as Date
        Case Else:                              blValid = InputTime_ƒAsMinutes(dOutput, vInput)     'Validate & Format as Minutes
        End Select

        Rem Enter Output
        If blValid Then
            Rem Validation was OK
            .Value = dOutput
            
        Else
            Rem Validation failed
            MsgBox Replace(kMsg, "#INP", vInput), vbInformation, "Input Time"
            .Value = vbNullString
            GoTo EXIT_Pcdr
        
        End If

    End With

EXIT_Pcdr:
    Application.EnableEvents = True

End Sub

Private Function InputTime_ƒAsDate(dOutput As Date, vInput As Variant) As Boolean

Dim vTime As Variant, dTime As Date
    
    Rem Output Initialize
    dOutput = 0
              
    Rem Validate & Process Input Value as Date
    vTime = Split(vInput, ":")
    Select Case UBound(vTime)
    
    Case 1
        
        On Error Resume Next
        dTime = TimeSerial(CInt(vTime(0)), CInt(vTime(1)), 0)   'Convert Input to Date
        On Error GoTo 0
        If dTime = 0 Then Exit Function                         'Input is Invalid
        dOutput = dTime                                         'Input is Ok
        
    Case Else:      Exit Function                               'Input is Invalid
    End Select

    InputTime_ƒAsDate = True
    
End Function

Private Function InputTime_ƒAsMinutes(dOutput As Date, vInput As Variant) As Boolean

Dim iTime As Integer, dTime As Date
    
    Rem Output Initialize
    dOutput = 0
                
    Rem Validate & Process Input Value as Integer
    On Error Resume Next
    iTime = vInput
    On Error GoTo 0
    Select Case iTime = vInput
    
    Case True
        On Error Resume Next
        dTime = TimeSerial(0, vInput, 0)    'Convert Input to Date
        On Error GoTo 0
        If dTime = 0 Then Exit Function     'Input is Invalid
        dOutput = dTime                     'Input is Ok
        
    Case Else:      Exit Function           'Input is Invalid
    End Select

    InputTime_ƒAsMinutes = True
    
End Function