在表格内的特定范围内填充日期答案

【问题标题】：Filling date on specific range inside a table在表格内的特定范围内填充日期
【发布时间】：2018-07-20 06:43:57
【问题描述】：

我有一个表格，我想在其中插入一个日期，如图所示。它会将日期复制到某个连续范围。程序必须找到范围，然后使用输入框插入日期。我使用了下面的代码。问题是它没有选择表格内的范围。如何解决这个问题。帮帮我

Sub FillFirstDay()
Dim ws As Worksheet
Dim rng As Range
Dim LastRow As Long
Dim table As ListObject
Dim dat As Date

Set ws = Sheets("Raw Data")
dat = Application.InputBox(prompt:="Enter the received date of the current Month", Title:="Date", Default:=Format(Date, "dd/mm/yyyy"), Type:=2)

If dat = False Then
MsgBox "Enter a Date", , "Date"
Exit Sub
End If

With ws
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    firstRow = .Range("C" & .Rows.Count).End(xlUp).Row + 1
    Set rng = Range(.Range("C" & firstRow), .Range("C" & LastRow))
End With

If firstRow >= LastRow Then Exit Sub

With rng
    .Value = dat
    .NumberFormat = "m/d/yyyy"
    .NumberFormat = "[$-409]dd-mmm-yy;@"
End With
End Sub

【问题讨论】：

标签： vba excel excel-2010 excel-tables

【解决方案1】：

这行是问题所在：

firstRow = .Range("C" & .Rows.Count).End(xlUp).Row + 1

.End(xlUp) 代码在向上的过程中抓住了表格的底部。您必须执行两次才能向上移动到数据所在的底部。此修改后的行将解决您的问题：

firstrow = .Range("C" & .Rows.Count).End(xlUp).End(xlUp).Row + 1

【讨论】：

非常感谢格雷格。完美运行。

【解决方案2】：

这个怎么样？

Sub FillFirstDay()
Dim ws As Worksheet
Dim tbl As ListObject
Dim rng As Range
Dim dat As Date

Set ws = Sheets("Raw Data")

dat = Application.InputBox(prompt:="Enter the received date of the current Month", Title:="Date", Default:=Format(Date, "dd/mm/yyyy"), Type:=2)

If dat = False Then
    MsgBox "Enter a Date", , "Date"
    Exit Sub
End If

Set tbl = ws.ListObjects(1)
On Error Resume Next
Set rng = tbl.DataBodyRange.Columns(3).SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If Not rng Is Nothing Then
    With rng
        .Value = dat
        .NumberFormat = "m/d/yyyy"
        .NumberFormat = "[$-409]dd-mmm-yy;@"
    End With
Else
    MsgBox "Date column is already filled.", vbExclamation
End If
End Sub

【讨论】：

【解决方案3】：

既然你有一个Table 对象，那就用它吧！

Option Explicit

Sub FillFirstDay()
    Dim aRow As Long, cRow As Long

    With Sheets("Raw Data").ListObjects("Table01").DataBodyRange 'reference ytour table object (change "Table01" to your actual table name)
        aRow = WorksheetFunction.CountA(.Columns(1))
        cRow = WorksheetFunction.CountA(.Columns(3))
        If cRow < aRow Then 'check for empty cells in referenced table 3rd column comparing to 1st one
            Dim dat As Date
            dat = Application.InputBox(prompt:="Enter the received date of the current Month", Title:="Date", Default:=Format(Date, "dd/mm/yyyy"), Type:=2)
            If dat = False Then 'check for a valid Date
                MsgBox "you must enter a Date", , "Date"
                Exit Sub
            Else
                With .Columns(3).Offset(cRow).Resize(aRow - cRow) 'select referenced table 3rd column cells from first empty one down to last 1st column not empty row
                    .Value = dat
                    .NumberFormat = "m/d/yyyy"
                    .NumberFormat = "[$-409]dd-mmm-yy;@"
                End With
            End If
        End If
    End With
End Sub

【讨论】：