要求:时间以小时和分钟报告,分钟是最低的衡量标准(即:无论时间量以小时报告,部分小时以分钟报告,即13 days, 1 hour and 32 minutes
或13.0638888888888889
应显示为313:32
) 应允许用户以两种不同的方式输入时间:
- 仅输入分钟:输入的值应为整数(无小数)。
- 输入小时和分钟: 输入的值应由代表小时和分钟的两个整数组成,用冒号分隔
:
。
输入的 Excel 处理值:
Excel 直观地处理在单元格中输入的值的Data type
和Number.Format
。当单元格NumberFormat
为常规时,Excel 将输入的值转换为与输入的数据相关的数据类型(字符串、双精度、货币、日期等),它还会NumberFormat
根据输入的值更改“格式”(参见下表)。
当单元格NumberFormat
不是常规时,Excel 会将输入的值转换为与单元格格式对应的数据类型,而不更改NumberFormat
(见下表)。
因此,不可能知道用户输入的值的格式,除非在 Excel 应用其处理方法之前可以截取输入的值。
虽然输入的值在 Excel 处理之前不能被截获,但我们可以为用户输入的值设置一个验证标准,使用Range.Validation property
.
解决方案: 这个建议的解决方案使用:
建议使用自定义style
来识别和格式化输入单元格,实际上 OP 是使用NumberFormat
来识别输入单元格,但是似乎也可能存在需要公式或对象(即汇总表PivotTables
等)的单元格一样NumberFormat
。通过仅对输入单元格使用自定义样式,可以轻松地将非输入单元格从流程中排除。
Style 对象 (Excel)允许为单个或多个单元格设置NumberFormat
、Font
、Alignment
、Borders
和。下面的过程添加了一个名为 的自定义样式。Style 的名称被定义为一个公共常量,因为它将在整个工作簿中使用。Interior
Protection
TimeInput
将此添加到标准模块中
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 对象 (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 - 支持函数
…</p>
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
…</p>
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
…</p>
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
下表显示了输入的各种类型值的输出。