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]:mm24: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）\n应允许用户以两种不同的方式输入时间：

\n

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

\n

Excel 处理输入的值：

\n

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

\n

\n

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

\n

\n

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

\n

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

\n

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

\n

\n
• Workbook.Styles 属性 (Excel)：识别输入单元格并设置其格式。
\n
• Range.Validation 属性 (Excel)：向用户传达输入值所需的格式，强制他们以文本形式输入数据。
\n
• Workbook_SheetChange 工作簿事件：验证并处理输入的值。
\n

\n

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

\n

Style对象 (Excel)允许为单个或多个单元格一次设置NumberFormat、Font、Alignment、Borders和Interior。Protection以下过程添加了一个名为 的自定义样式TimeInput。样式的名称被定义为公共常量，因为它将在整个工作簿中使用。

\n

将其添加到标准模块中

\n

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

\n

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

\n

\n

我们\xe2\x80\x99 将使用Validation 对象 (Excel)告诉用户时间值的条件并强制他们输入值Text。\n以下过程设置输入范围的样式并向每个值添加验证细胞：

\n

Private Sub InputRange_Set_Properties(Rng As Range)\n\nConst kFml As String = "=ISTEXT(#CLL)"\nConst kTtl As String = "Time as [\'M] or [\'H:M]"\nConst kMsg As String = "Enter time preceded by a apostrophe [\']" & vbLf & _\n                            "enter M minutes as \'M" & vbLf & _\n                            "or H hours and M minutes as \'H:M"  \'Change as required\nDim sFml As String\n    \n    Application.EnableEvents = False\n    \n    With Rng\n\n        .Style = pk_StyTmInp\n        sFml = Replace(kFml, "#CLL", .Cells(1).Address(0, 0))\n\n        With .Validation\n            .Delete\n            .Add Type:=xlValidateCustom, _\n                AlertStyle:=xlValidAlertStop, _\n                Operator:=xlBetween, Formula1:=sFml\n            .IgnoreBlank = True\n            .InCellDropdown = False\n\n            .InputTitle = kTtl\n            .InputMessage = kMsg\n            .ShowInput = True\n\n            .ErrorTitle = kTtl\n            .ErrorMessage = kMsg\n            .ShowError = True\n\n    End With: End With\n\n    Application.EnableEvents = True\n\nEnd Sub\n

\n

该过程可以这样调用

\n

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

\n

现在我们已经使用适当的样式和验证设置了输入范围，让\xe2\x80\x99s 编写Workbook Event将处理时间输入的代码：

\n

将这些过程复制到ThisWorkbook模块中：

\n

\n
• Workbook_SheetChange - 工作簿事件
\n
• InputTime_\xc6\x92AsDate - 支持函数
\n
• InputTime_\xc6\x92AsMinutes - 支持功能
\n

\n

\xe2\x80\xa6

\n

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)\n\nConst kMsg As String = "[ #INP ] is not a valid entry."\nDim blValid As Boolean\nDim vInput As Variant, dOutput As Date\nDim iTime As Integer\n    \n    Application.EnableEvents = False\n    \n    With Target\n\n        Rem Validate Input Cell\n        If .Cells.Count > 1 Then GoTo EXIT_Pcdr         \'Target has multiple cells\n        If .Style <> pk_StyTmInp Then GoTo EXIT_Pcdr    \'Target Style is not TimeInput\n        If .Value = vbNullString Then GoTo EXIT_Pcdr    \'Target is empty\n        \n        Rem Validate & Process Input Value\n        vInput = .Value                         \'Set Input Value\n        Select Case True\n        Case Application.IsNumber(vInput):      GoTo EXIT_Pcdr      \'NO ACTION NEEDED - Cell value is not a text thus is not an user input\n        Case InStr(vInput, ":") > 0:            blValid = InputTime_\xc6\x92AsDate(dOutput, vInput)        \'Validate & Format as Date\n        Case Else:                              blValid = InputTime_\xc6\x92AsMinutes(dOutput, vInput)     \'Validate & Format as Minutes\n        End Select\n\n        Rem Enter Output\n        If blValid Then\n            Rem Validation was OK\n            .Value = dOutput\n            \n        Else\n            Rem Validation failed\n            MsgBox Replace(kMsg, "#INP", vInput), vbInformation, "Input Time"\n            .Value = vbNullString\n            GoTo EXIT_Pcdr\n        \n        End If\n\n    End With\n\nEXIT_Pcdr:\n    Application.EnableEvents = True\n\nEnd Sub\n

\n

\xe2\x80\xa6

\n

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

\n

\xe2\x80\xa6

\n

Private Function InputTime_\xc6\x92AsMinutes(dOutput As Date, vInput As Variant) As Boolean\n\nDim iTime As Integer, dTime As Date\n    \n    Rem Output Initialize\n    dOutput = 0\n                \n    Rem Validate & Process Input Value as Integer\n    On Error Resume Next\n    iTime = vInput\n    On Error GoTo 0\n    Select Case iTime = vInput\n    \n    Case True\n        On Error Resume Next\n        dTime = TimeSerial(0, vInput, 0)    \'Convert Input to Date\n        On Error GoTo 0\n        If dTime = 0 Then Exit Function     \'Input is Invalid\n        dOutput = dTime                     \'Input is Ok\n        \n    Case Else:      Exit Function           \'Input is Invalid\n    End Select\n\n    InputTime_\xc6\x92AsMinutes = True\n    \nEnd Function\n

\n

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

\n

\n