table 内特定范围内的填充日期

Question

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

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

Answer 1

这一行就是问题所在：

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

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

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

Answer 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

Answer 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

table 内特定范围内的填充日期

Filling date on specific range inside a table

excel

vba

excel-2010

excel-tables