从列中提取年、月和日以创建 Excel 格式的日期列

Question

我基本上想从相应的列中提取年、月和日，并用它们用VBA创建一个excel格式的日期列。

使用屏幕截图，它首先应该是这样的： Excel Spreadsheet with Year Column and Date Column.

然而，最终应该删除年份列，只保留日期列（撇开描述）并包含 excel 格式的日期。 Excel Spreadsheet with Date Column only

现在，可能有更简单的方法来完成这项任务，但我采取的方法是：

1. 在日期列的右侧插入两个新列
2. 选择日期列并使用Text to Columns功能将月份移动到右侧新创建的列
3. 将新创建的第二个空白列格式化为日期类别
4. 在此空白列的单元格中插入日期函数，然后将其自动填充到下面的单元格中。更准确地说，这个日期函数是：=DATE(A2,MONTH(1&C2),B2)
5. 复制此新日期列并将其粘贴回作为值，仅供以后排序之用。
6. 删除所有其他无用的列（年、月、日）

虽然这在 excel 界面上是可行的，但我想用 VBA 来完成这个任务，所以我已经写了很多代码。不幸的是，作为 VBA 的新手，我目前被困在最后日期列中应用公式。

在您查看我的代码之前，我还想指出，我提示用户选择 Description 列作为参考列，因为并非总是如此年份列是第一列，或者日期列是第二列。然而，绝对可以肯定的是，在描述列的左侧，分别有日期和年份列。

最后，如果有人还通过仅允许将公式应用于包含年份或日期的第一行和最后一行（同样的事情）来改进我的 VBA 代码，我将不胜感激。

提前感谢大家。

下面是我的代码

    Sub Macro1()

'Set variables
Dim DescRng As Range
Dim DayRng As Range
Dim MonthRng As Range
Dim YearRng As Range
Dim DateRng As Variant

'Obtain reference column with prompt
Set DescRng = Application.InputBox("Select Description Column", "Obtain Object Range", Type:=8)

'Create new columns from reference column
Columns(DescRng.Column).Insert Shift:=x1ToLeft
Columns(DescRng.Column).Insert Shift:=x1ToLeft

'Assign variables to columns
Set DateRng = DescRng.Offset(rowOffset:=0, columnOffset:=-1)
Set MonthRng = DescRng.Offset(rowOffset:=0, columnOffset:=-2)
Set DayRng = DescRng.Offset(rowOffset:=0, columnOffset:=-3)
Set YearRng = DescRng.Offset(rowOffset:=0, columnOffset:=-4)

'Seperate the days from the months with TextToColumns
Columns(DayRng.Column).TextToColumns Destination:=DayRng, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

'Format the DateRng column for later sorting use
Columns(DateRng.Column).NumberFormat = "yyyy-mm-dd"

'Apply Formula to DateRng Column


'Copy Formula in DateRng and paste into the same column as values
Columns(DateRng.Column).Copy
Columns(DateRng.Column).PasteSpecial Paste:=xlPasteValues, SkipBlanks _
        :=False, Transpose:=False

'Delete the other Columns (YearRng, MonthRng, DayRng)
YearRng.Delete
DayRng.Delete
MonthRng.Delete

End Sub

编辑：感谢您的回答带来的洞察力。与我未完成的任务不同，您用简短的代码完成了一项简单的任务。从我的第一篇文章中学到了很多。谢谢

Answer 1

尝试使用 A 列和 B 列中显示的值创建一个有效的字符串日期。

with worksheets("sheet1")
    for i=2 to .cells(rows.count, 1).end(xlup).row
        .cells(i, 1) = datevalue(.cells(i, 2).text & ", " & .cells(i, 1).text)
        .cells(i, 1).numberformat = "yyyy-mm-dd"
    next i
    .columns(2).entirecolumn.delete
    .cells(1, 1) = "date"
end with

Answer 2

我采取了与@Jeeped 不同的方法，所以我想我会分享，因为无论如何我都花时间练习你的问题。您只需要使用所需的日期格式格式化 Col A。

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim DayMonth As Variant

ws.Columns("A:A").Insert: ws.Range("A1") = "Date"

For i = 2 To ws.Range("B" & ws.Rows.Count).End(xlUp).Row
    DayMonth = Split(ws.Range("C" & i), Chr(32))
    ws.Range("A" & i) = DateValue(DayMonth(0) & Chr(32) & Month(1 & DayMonth(0)) & Chr(32) & ws.Range("B" & i) & Chr(32))
Next i

ws.Columns("A:A").AutoFit
ws.Columns("B:C").Delete