Excel 365 VBA 小时和分钟格式

Question

我正在处理一个简单的 Excel 文件，其中包含一些工作表，其中我在每个工作表中报告了工作时间和分钟数。我想像 313:32 一样显示它，即 313 小时 32 分钟，为此我使用自定义格式 [h]:mm

为了方便很少使用Excel的工作人员，我想创建一些vba代码，这样他们不仅可以插入会议记录，还可以插入经典格式[=13] =]，因此他们还可以按小时和分钟插入值。我报告了一些我想要的示例数据。我插入的内容 -> 单元格内打印的我想要的内容

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

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

以下方法也适用于 General、Text 和 Time 等格式（除非时间从一天开始，但可以进一步开发以在必要时也处理它）。

Public Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error GoTo bm_Safe_Exit
    
    Dim part As String, parts() As String, total As Single
    
    Application.EnableEvents = False
    
    If Not IsEmpty(Target) And Target.NumberFormat = "[h]:mm" Then
        'prefer how the Target looks over its underlying value
        If InStr(Target.Text, ":") Then
            'split by ":" then add the parts to give the decimal value
            parts = Split(Target.Text, ":")
            total = 0
            
            'hours
            If IsNumeric(parts(0)) Then
                total = CInt(parts(0)) / 24
            End If
            
            'minutes
            If 0 < UBound(parts) Then
                If IsNumeric(parts(1)) Then
                    total = total + CInt(parts(1)) / 1440
                End If
            End If
        ElseIf IsNumeric(Target.Value) Then
            'if it doesn't look like a time format but is numeric, count as minutes
            total = Target.Value / 1440
        End If
        
        Target.Value = total
    End If
    
bm_Safe_Exit:
    Application.EnableEvents = True
End Sub

Answer 2

要求：时间要以小时和分钟为单位报告，分钟是最低的衡量标准（即：无论多少时间都以小时和部分小时为单位报告以分钟为单位，即 13 days, 1 hour and 32 minutes 或 13.0638888888888889 应显示为 313:32 ）应该允许用户以两种不同的方式输入时间：

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

Excel 输入的处理值：

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

当单元格 NumberFormat 不是常规时，Excel 将输入的值转换为与单元格格式对应的数据类型，而 NumberFormat (请参阅下面的 table。

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

虽然输入的值在Excel处理之前无法拦截，但我们可以使用Range.Validation property.

为用户输入的值设置一个验证标准

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

Workbook.Styles property (Excel): 识别和格式化输入单元格。
Range.Validation property (Excel)：向用户传达输入值所需的格式，强制他们以文本形式输入数据。
Workbook_SheetChange 工作簿事件：验证和处理输入的值。

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

Style object (Excel) 允许设置 NumberFormat、Font、Alignment、Borders、Interior 和 Protection一次用于单个或多个单元格。下面的过程添加了一个名为 TimeInput 的自定义样式。样式的名称定义为 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

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

我们将使用 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

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

Excel 365 VBA 小时和分钟格式

Excel 365 VBA for hours and minutes format

excel

vba

excel-365