如何使用 VBA 将日期连接到单个组合框中

Question

我正在使用表单在 Excel 中填充工作表。在表单中，与日期相关的框由日-月-年组合框分解，这些组合框被连接起来填充工作表中的单个单元格。我的问题是是否有办法在单个单元格中“取消连接”日期并使用适当的信息（日、月或年）填充每个单独的组合框。这是因为我希望能够以一种形式添加新信息，然后以另一种形式更新表中已经存在的信息。

根据以下给定参数更新表单的代码（聚焦在粗体）：

Private Sub txtstudynm_Change()

Dim StudyName As String
Dim WrdString As String
Dim text_string As String


If Me.txtstudynm.Value = "" Then
    MsgBox "Study Name can not be blank", vbCritical
    Exit Sub
End If

StudyName = txtstudynm.Value

On Error Resume Next
Me.cmbprojman.Value = Application.WorksheetFunction.VLookup(StudyName, Sheets("Study Summary").Range("A3:AJ3000"), 2, 0)

On Error Resume Next
Me.cmbstudtyp.Value = Application.WorksheetFunction.VLookup(StudyName, Sheets("Study Summary").Range("A3:AJ3000"), 3, 0)

On Error Resume Next
Me.cmbprogtyp.Value = Application.WorksheetFunction.VLookup(StudyName, Sheets("Study Summary").Range("A3:AJ3000"), 4, 0)

On Error Resume Next
Me.cmbfundtyp.Value = Application.WorksheetFunction.VLookup(StudyName, Sheets("Study Summary").Range("A3:AJ3000"), 5, 0)

On Error Resume Next
Me.txtbudget.Value = Application.WorksheetFunction.VLookup(StudyName, Sheets("Study Summary").Range("A3:AJ3000"), 6, 0)

On Error Resume Next
Me.txtencumb.Value = Application.WorksheetFunction.VLookup(StudyName, Sheets("Study Summary").Range("A3:AJ3000"), 7, 0)

On Error Resume Next
Me.cmbpath.Value = Application.WorksheetFunction.VLookup(StudyName, Sheets("Study Summary").Range("A3:AJ3000"), 8, 0)

**On Error Resume Next**

**text_string = Application.WorksheetFunction.VLookup(StudyName, Sheets("Study Summary").Range("A3:AJ3000"), 9, 0).Value**  

**WrdString = Split(text_string, "/")(0)** 

**Me.tssdcmb1.Value = WrdString**

On Error Resume Next
Me.tssdcmb2.Value = WorksheetFunction.VLookup(StudyName, Sheets("Study Summary").Range("A3:AJ3000"), 9, 0)

On Error Resume Next
Me.tssdcmb3.Value = WorksheetFunction.VLookup(StudyName, Sheets("Study Summary").Range("A3:AJ3000"), 9, 0)

End Sub

Answer 1

使用 Variant 数组代替所有对工作表的引用：

Private Sub txtstudynm_Change()

If Me.txtstudynm.Value = "" Then
    MsgBox "Study Name can not be blank", vbCritical
    Exit Sub
End If

Dim StudyName As String
StudyName = txtstudynm.Value

Dim lkp As Variant
lkp = Sheets("Study Summary").Range("A3:AJ3000").Value2

Dim i As Long
For i = 1 To UBound(lkp, 1)
    If lkp(i, 1) = StudyName Then
        Me.cmbprojman.Value = lkp(i, 2)
        Me.cmbstudtyp.Value = lkp(i, 3)
        Me.cmbprogtyp.Value = lkp(i, 4)
        Me.cmbfundtyp.Value = lkp(i, 5)
        Me.txtbudget.Value = lkp(i, 6)
        Me.txtencumb.Value = lkp(i, 7)
        Me.cmbpath.Value = lkp(i, 8)
        Me.tssdcmb1.Value = Day(lkp(i, 9))
        Me.tssdcmb2.Value = Month(lkp(i, 9))
        Me.tssdcmb3.Value = Year(lkp(i, 9))
        Exit For
    End If
Next i

End Sub

Answer 2

试试这个（不确定您将哪个组合框设置为日/月/年）...

Dim StudyDate as Date
If IsDate(text_string) Then
    StudyDate = CDate(txt)
    Me.tssdcmb1.Value Day(StudyDate)
    Me.tssdcmb2.Value Month(StudyDate)
    Me.tssdcmb3.Value Year(StudyDate)
End If

Answer 3

将text_string 声明为正确的Date 值（这就是为什么您不在变量名中编码变量的数据类型的原因）。然后 VLOOKUP 将产生一个Date 值：

text_string = Application.WorksheetFunction.VLookup(StudyName, Sheets("Study Summary").Range("A3:AJ3000"), 9, 0).Value

如果您拥有的是正确的Date，那么您使用VBA.DateTime.Year、VBA.DateTime.Month 和VBA.DateTime.Day 函数来获取每个部分：

Me.tssdcmb1.Value = Year(text_string)
Me.MonthBox.Value = Month(text_string)
Me.DayBox.Value = Day(text_string)

请注意有意义、易读的名称如何使代码更易于阅读/遵循。

---

如果你真的是一个看起来像日期的字符串，那么……你最好希望格式是一致的，然后像你一样使用VBA.Strings.Split函数不是'这是个坏主意 - 只需使用你得到的 3 个索引：

Dim dateParts As Variant
dateParts = Split(text_string, "/")

Me.YearBox.Value = dateParts(0)
Me.MonthBox.Value = dateParts(1)
Me.DayBox.Value = dateParts(2)