Excel 365 VBA 小时和分钟格式

Question

我正在处理一个简单的 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所以 24:00 在 vba 代码执行之前变成了 1 !
我试图更正代码，有趣的事实是，当我更正 24:00，所以 24:00 仍然是 24:00 而不是 00:24，问题切换到 1，变成 24:00 而不是 00:01
我的第一个想法是在单元格格式之前“强制”执行 vba 代码，但我不知道这是否可能。
我知道这似乎是一个愚蠢的问题，但我真的不知道这是否可能以及如何解决它。
任何想法将不胜感激

Answer 1

要求: 时间以小时和分钟报告，分钟是最低度量(即:无论时间量以小时报告，部分小时以分钟报告，即 13 days, 1 hour and 32 minutes 或 13.0638888888888889 应显示为 313:32 )
应该允许用户以两种不同的方式输入时间:

仅输入分钟:输入的值应为整数(无小数)。

输入小时和分钟:输入的值应由代表小时和分钟的两个整数组成，用冒号隔开 : 。

输入的 Excel 处理值:
Excel直观地处理单元格中输入的值的 Data type和 Number.Format。
当单元格 NumberFormat 为 General 时，Excel 将输入的值转换为与输入的数据相关的数据类型(字符串、 double 、货币、日期等)，它还会根据输入的“格式”更改 NumberFormat 值(见下表)。

当单元格 NumberFormat 不是 General 时，Excel 会将输入的值转换为与单元格格式对应的数据类型，而不更改 NumberFormat(见下表)。

因此，不可能知道用户输入的值的格式，除非在 Excel 应用其处理方法之前可以截取输入的值。
虽然输入的值在 Excel 处理之前无法被截取，但我们可以使用 Range.Validation property 为用户输入的值设置验证标准。
解决方案: 此建议的解决方案使用:

Workbook.Styles property (Excel):识别和格式化输入单元格。

Range.Validation property (Excel) :向用户传达输入值所需的格式，强制他们以文本形式输入数据。

Workbook_SheetChange 工作簿事件:验证和处理输入的值。

建议使用自定义的 style 来识别和格式化输入单元格，实际上 OP 正在使用 NumberFormat 来识别输入单元格，但是似乎也可能存在带有公式或对象的单元格(即汇总表、 PivotTables 等。 ) 需要相同的 NumberFormat 。通过仅对输入单元格使用自定义样式，可以轻松地将非输入单元格从流程中排除。
Style object (Excel) 允许一次为单个或多个单元格设置 NumberFormat 、 Font 、 Alignment 、 Borders 、 Interior 和 Protection 。下面的过程添加了一个名为 TimeInput 的自定义样式。 Style 的名称被定义为一个公共(public)常量，因为它将在整个工作簿中使用。
将此添加到标准模块中

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

新样式将显示在主页选项卡中，只需选择输入范围并应用样式。

我们将使用 Validation object (Excel) 告诉用户时间值的标准，并强制他们将值输入为 Text 。
以下过程设置输入范围的样式并向每个单元格添加验证:

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

现在我们已经使用适当的样式和验证设置了输入范围，让我们编写将处理时间输入的 Workbook Event:
将这些程序复制到 ThisWorkbook 模块中:

Workbook_SheetChange - 工作簿事件

InputTime_ƒAsDate - 支持函数

InputTime_ƒAsMinutes - 支持函数

…

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

下表显示了输入的各种类型值的输出。