问题描述
我正在处理一个简单的 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 代码,但我不知道是否可行。 我知道这似乎是一个愚蠢的问题,但我真的不知道是否可行以及如何解决。
任何想法将不胜感激
解决方法
要求:时间以小时和分钟为单位报告,分钟是最低度量(即:无论以小时为单位报告多少时间,以分钟为单位报告部分小时,即{ {1}} 或 13 days,1 hour and 32 minutes
应显示为 13.0638888888888889
)
应允许用户以两种不同的方式输入时间:
- 仅输入分钟:输入的值应为整数(无小数)。
- 输入小时和分钟:输入的值应由代表小时和分钟的两个整数组成,用冒号
313:32
分隔。
输入的 Excel 处理值:
Excel 直观地处理单元格中输入的值的 :
和 Data type
。
当单元格 Number.Format
为 General 时,Excel 将输入的值转换为与输入的数据相关的数据类型(String、Double、Currency、Date 等),它也会根据与值一起输入的“格式”(见下表)。
当单元格 NumberFormat
不是 General 时,Excel 将输入的值转换为与单元格格式对应的数据类型,而不更改 NumberFormat
(见下表)。
因此,不可能知道用户输入的值的格式,除非在Excel应用其处理方法之前可以拦截输入的值。
虽然输入的值在 Excel 处理之前无法被拦截,但我们可以使用 NumberFormat
为用户输入的值设置验证标准。
解决方案:这个提议的解决方案使用:
- Workbook.Styles property (Excel):识别和格式化输入单元格。
- Range.Validation property (Excel):向用户传达输入值所需的格式,强制他们以文本形式输入数据。
- Workbook_SheetChange 工作簿事件:验证和处理输入的值。
建议使用自定义的NumberFormat
来识别和格式化输入单元格,实际上OP是使用Range.Validation property
来识别输入单元格,但是似乎也有带有公式的单元格,或需要相同 style
的对象(即汇总表、NumberFormat
等)。通过仅对输入单元格使用自定义样式,可以轻松地将非输入单元格从流程中排除。
Style object (Excel) 允许一次设置 PivotTables
、NumberFormat
、NumberFormat
、Font
、Alignment
和 Borders
对于单个或多个单元格。下面的过程添加了一个名为 Interior
的自定义样式。样式的名称被定义为公共常量,因为它将在整个工作簿中使用。
将其添加到标准模块中
Protection
新样式将显示在主页选项卡中,只需选择输入范围并应用样式即可。
我们将使用 Validation object (Excel) 告诉用户时间值的标准,并强制他们将值输入为 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
程序可以这样调用
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_SheetChange - 工作簿事件
- InputTime_ƒAsDate - 支持函数
- InputTime_ƒAsMinutes - 支持函数
…
Workbook Event
…
ThisWorkbook
…
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
下表显示了输入的各种类型值的输出。
,最简单的方法似乎是使用单元格文本(即单元格的显示方式)而不是实际的单元格值。如果它看起来像一个时间(例如 "[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