vba - 用户窗体中的 DateDiff 公式
问题描述
我有两个包含开始日期和结束日期的文本框。
我想得到一个代表这两者之间的日子的数字。
Private Sub TextBox20_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'check date format
With TextBox20
If IsDate(TextBox20.Text) Then 'Format as desired.
TextBox20.Text = Format(CDate(TextBox20.Text), "Dddd, d Mmm yyyy", vbMonday)
Else
TextBox20.Text = "" 'Clear the TextBox
MsgBox "Por favor, ingresar una fecha valida."
Cancel = True
Exit Sub
End If
End With
End Sub
Private Sub TextBox21_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'check date format
With TextBox21
If IsDate(TextBox21.Text) Then 'Format as desired.
TextBox21.Text = Format(CDate(TextBox21.Text), "Dddd, d Mmm yyyy", vbMonday)
Else
TextBox21.Text = "" 'Clear the TextBox
MsgBox "Por favor, ingresar una fecha valida."
Cancel = True
Exit Sub
End If
End With
End Sub
Private Sub TextBox22_AfterUpdate()
TextBox22.Value = DateDiff("d", CDate(TextBox20.Value), CDate(TextBox21.Value), vbMonday)
End Sub
我认为这是因为我有 TextBoxes.Text
和 not .Value
,但没有任何变化。
解决方案
DateDiff
基于文本框字符串的正确计算
尽管我通常建议不要将原始控件条目(日期)覆盖为文本框中重新格式化的(日期)字符串,但我展示了一种与您的方法非常接近的可能方式。这包括对可读日期字符串的一些规定,以便进行DateDiff()
计算。
UserForm代码模块的声明头
为了保存正确的开始日期和结束日期(作为Date
类型而不是字符串),我定义了一个Type
结构,可以在后续过程中轻松重用。
Option Explicit
Private Type TThis
StartDate As Date
EndDate As Date
End Type
Dim this As TThis
示例程序
Sub CheckDays()
DateDiff
根据上面声明的类型结构中的条目计算。它与您的代码不同,因为每次退出文本框输入后都会调用计算函数。Function getDateString()
尝试通过调整可能导致错误日期转换的格式结果来使 TextBox 字符串可转换为 Date 类型。在调用计算IsDate()
之前,在文本框的事件过程中进行最终检查。CheckDays
Private Sub CheckDays()
' Purpose: calculate DateDiff and enter result into TextBox22
' Note : called by TextBox20_Exit|TextBox21_Exit events
If this.StartDate > 0 And this.EndDate >= this.StartDate Then
TextBox22.Text = DateDiff("d", this.StartDate, this.EndDate, vbMonday)
End If
End Sub
Private Function getDateString(ByVal txt As String) As String
' Purpose: make (TextBox) string convertible to Date type, if possible
'a) remove leading day names (e.g. "Wednesday, 1 Jan 2020" ~> "1 Jan 2020")
If InStr(txt, ",") > 0 Then txt = Split(txt, ",")(1)
'b) add current year if missing (e.g. "1.1." ~> "1.1.2020")
If Not IsDate(txt) Then
If IsDate(txt & " " & Year(Now)) Then txt = txt & " " & Year(Now)
End If
getDateString = txt ' return function result
End Function
用户窗体事件过程
这些程序几乎没有变化,但包括
- 通过
DateString
`getDateString() 分配以提供可转换的日期字符串以及 CheckDays
计算的过程调用DateDiff
并将结果输入到TextBox22
.
附加说明:_Exit
也可以使用事件来代替事件_AfterUpDate
。
Private Sub TextBox20_Exit(ByVal Cancel As MSForms.ReturnBoolean)
With TextBox20
Dim DateString As String
DateString = getDateString(.Text) 'Make TextBox string convertible to Date type.
'check date format
If IsDate(DateString) Then 'Format as desired.
this.StartDate = CDate(DateString) 'Remember date (Date type).
.Text = Format(this.StartDate, "Dddd, d Mmm yyyy", vbMonday)
'========
CheckDays '<< Call procedure to calculate DateDiff.
'--------
Else
.Text = "" 'Clear the TextBox string
this.EndDate = 0
MsgBox "Por favor, ingresar una fecha valida."
Cancel = True
Exit Sub
End If
End With
End Sub
Private Sub TextBox21_Exit(ByVal Cancel As MSForms.ReturnBoolean)
With TextBox21
Dim DateString As String
DateString = getDateString(.Text) 'Make TextBox string convertible to Date type.
'check date format
If IsDate(DateString) Then 'Format as desired.
this.EndDate = CDate(DateString) 'Remember date (Date type).
.Text = Format(this.EndDate, "Dddd, d Mmm yyyy", vbMonday)
'========
CheckDays '<< call procedure to calculate DateDiff
'--------
Else
.Text = "" 'Clear the TextBox string
this.EndDate = 0
MsgBox "Por favor, ingresar una fecha valida."
Cancel = True
Exit Sub
End If
End With
End Sub
推荐阅读
- node.js - 如何使用纱线正确安装 expo-cli?
- spring-data-mongodb - Spring MongoTemplate 不是正在进行的事务的一部分
- php - 无法通过 PHP 但使用 Postman 接收标头信息
- ansible - 如何在 jinja2 中转义双花括号?
- java - 当我尝试将我的应用程序连接到 webServices 时失败
- java - 如何在不清除窗口的情况下在 Swing 中重新绘制?
- google-apps-script - How to write Google Analytics API data to a new row, rather than a new sheet
- c++ - 为什么将临时对象作为参数传递需要 std::move?
- git - 如何关闭 git 输出中的帮助提示?
- c++ - 将流转换为布尔 - 如何在 getline() 中完成