Question

我目前有多个电子表格，每个员工都有一行日期。在弹出的为每个员工修改的用户表单中，日期的顶部是一个地方，他们填写了其余信息，然后提交。
有没有办法将工作表上的日期与用户表单上的日期进行匹配，以填充下面的列？

Answer 1

假设表单上有一个文本框，您可以在其中输入日期。

这第一段代码是确保您在文本框中有一个日期，而不是其他任何日期。

将其粘贴到普通模块中。您可以将其放置在表单中，但可以在模块中允许包含日期的任何其他表单使用它。

Public Sub FormatDate(ctrl As Control)

    Dim dDate As Date
    Dim IsDate As Boolean

    On Error GoTo ERR_HANDLE

    If Replace(ctrl.Value, " ", "") <> "" Then
        On Error Resume Next
            dDate = CDate(ctrl.Value)
            IsDate = (Err.Number = 0)
            On Error GoTo -1
        On Error GoTo ERR_HANDLE

        If IsDate Then
            ctrl.Value = Format(ctrl.Value, "dd-mmm-yyyy")
            ctrl.BackColor = RGB(255, 255, 255)
        Else
            ctrl.BackColor = RGB(255, 0, 0)
        End If
    End If

EXIT_PROC:
        On Error GoTo 0
        Exit Sub

ERR_HANDLE:
        MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "FormatDate()"
        Resume EXIT_PROC

End Sub

将其作为文本框的AfterUpdate事件放置在表单上：

Private Sub txtDate_AfterUpdate()

    On Error GoTo ERR_HANDLE

    With Me
        FormatDate .txtDate
    End With

EXIT_PROC:
        On Error GoTo 0
        Exit Sub

ERR_HANDLE:
        MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "txtDate_AfterUpdate()"
        Resume EXIT_PROC

End Sub

任何有效日期将被格式化为 dd-mmm-yyyy ，任何无效日期将使控件的背景变为红色。

接下来，您需要在工作表的第1行上找到日期。同样，可以将其保留在常规模块中，以便您可以在表格之外使用它：

Public Function FindDate(DateValue As Date) As Range

    Dim rFound As Range

    With Sheet2
        Set rFound = .Rows(1).Find(DateValue, .Cells(1, 1), xlValues, xlWhole)

        If rFound Is Nothing Then
            Set rFound = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1)
        End If

    End With

    Set FindDate = rFound

End Function

这将返回日期所在的单元格，或者如果找不到日期，则返回第1行的最后一个空白单元格。

我不确定您是否需要此位，但这会在指定的列号中找到包含数据的最后一个单元格：

Public Function LastCell(wrksht As Worksheet, Col As Long) As Range

    Dim lLastRow As Long

    On Error Resume Next
        lLastRow = wrksht.Columns(Col).Find("*", , , , xlByColumns, xlPrevious).Row
    On Error GoTo 0

    If lLastRow = 0 Then lLastRow = 1

    Set LastCell = wrksht.Cells(lLastRow, Col)

End Function

现在，您只需要将代码附加到“查找”按钮即可返回您指定日期以下的第一个空白单元格：

Private Sub btnFind_Click()

    Dim rFoundCell As Range

    'First blank cell beneath date.
    Set rFoundCell = LastCell(Sheet1, FindDate(CDate(Me.txtDate)).Column).Offset(1)

End Sub

如果您只想查找日期，则可以使用：

Set rFoundCell = FindDate(CDate(Me.txtDate))

Find上的帮助文件为here。

在Excel中查找日期可能有问题：

将文本框条目与单元格匹配，以用用户窗体数据填充列

1 个答案: