Question

我试图通过特定列中的一系列单元格传递在此输入框中输入的日期。范围不是特定的，但必须填充当前包含该列数据的所有单元格。

'Date input box
    Sub dateInput()
        Dim dateString As String, TheDate As Date
        dateString = Application.InputBox("Enter Certificate Date")
        If IsDate(dateString) Then
            TheDate = DateValue(dateString)
        Else
            MsgBox "That's not good!"
        End If
    End Sub

就我而言，我似乎无法将输入的日期输入到细胞范围内。

Answer 1

您可以使用以下示例将日期中的所有非空单元格替换为日期：

Sub dateInput()
    Dim dateString As String, TheDate As Date
    Dim rng As Range
    Dim LastRow As Long
    Dim LastCol As Long
    Dim ws As Worksheet
    Dim wb As Workbook

    Set wb = ActiveWorkbook '<-- Workbook you are working in
    Set ws = wb.ActiveSheet '<-- Worksheet you are working in


    With ws
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then '<-- Finding last row used
            LastRow = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
             '<-- Finding last column used
            LastCol = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByColumns, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Column
        Else
            LastCol = 1 '<-- Selecting first column if nothing found
            LastRow = 1 '<-- Selecting first row if nothing found
        End If
    End With

    Set rng = ActiveSheet.Range(Cells(1, 1), Cells(LastRow, LastCol)) '<-- You can set your range here

    dateString = Application.InputBox("Enter Certificate Date")
    If IsDate(dateString) Then
        TheDate = DateValue(dateString)

        For Each c In rng.Cells
            If c.Value <> "" Then
                c.Value = TheDate
            End If
        Next
    Else
        MsgBox "That's not good!"
    End If
End Sub

Answer 2

这将允许用户选择列：

Sub dateInput()
        Dim dateString As String, TheDate As Date, r As Range
        dateString = Application.InputBox("Enter Certificate Date")
        If IsDate(dateString) Then
            TheDate = DateValue(dateString)
        Else
            MsgBox "That's not good!"
        End If

   Set r = Application.InputBox("O.K.  Now pick a column", Type:=8)
   For Each rr In Intersect(r, ActiveSheet.UsedRange)
      If rr.Value <> "" Then
         rr.Value = TheDate
      End If
   Next rr
End Sub

Answer 3

你有一些逻辑错误，所以我修复它，即使用dateString但没有声明，并在没有设置值时检查它（假设你修复它，因为它不再显示在你的代码中）。除此之外，您只需要定义范围并设置值。以下示例

Sub dateInput()
Dim r As Range
Set r = Cells.Range(Cells(1, 1), Cells(10, 1))


    Dim TheString As String, TheDate As Date
    TheString = Application.InputBox("Enter Certificate Date")
    If IsDate(TheString) Then
        TheDate = DateValue(TheString)
    Else
        MsgBox "That's not good!"
    End If

    r.Value = TheDate
End Sub

将日期输入字符串传递给单元格区域

3 个答案: