Дата заполнения в определенном диапазоне внутри таблицы

Question

У меня есть таблица, где я хотел бы вставить дату, как показано на рисунке. Это скопирует дату в некоторый непрерывный диапазон. Программа должна найти диапазон, а затем вставить дату, используя поле ввода. Я использовал код ниже. Проблема в том, что он не выбирает диапазон внутри таблицы. Как это решить. Помоги мне

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) код ловит нижнюю часть таблицы на своем пути вверх. Вы должны сделать это дважды, чтобы перейти к нижней части данных. Эта измененная строка исправит вашу проблему:

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

Answer 2

Так как у вас есть 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

Answer 3

Как насчет этого?

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