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

时间:2018-07-21 21:32:21

标签: excel vba excel-vba

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

带有屏幕截图,乍一看应该是这样的: Excel Spreadsheet with Year Column and Date Column

最终,年份列​​应删除,仅保留日期列(不包括描述),并且包含excel格式的日期Excel Spreadsheet with Date Column only

现在,也许有一种更简单的方法来完成此任务,但是我所采用的方法是:

  1. 日期
  2. 右侧插入两个新列
  3. 选择日期列,并使用文本到列功能 在右侧新建的列
  4. 将空白的第二个新创建的列设置为“日期”类别
  5. 将日期函数插入此空白列的单元格中,并将其自动填充到下面的单元格中。更准确地说,此日期函数为:= DATE(A2,MONTH(1&C2),B2)
  6. 复制此“新日期”列并将其粘贴回作为值,仅用于以后的排序目的。
  7. 删除所有其他无用的列(年,月,日)

尽管这对于excel接口是可行的,但我想使用VBA完成此任务,因此我已经编写了很多代码。不幸的是,作为VBA的新手,我目前只能在最终日期栏中应用公式。

在查看我的代码之前,我还要指出,我提示用户选择“描述”列作为参考列,因为并非总是这样年列是第一列,而日期列是第二列。但是,绝对可以确定的是,“描述”列的左侧分别有“日期”和“年份”列。

最后,如果有人还通过只允许将该公式应用于包含年份或日期的第一行和最后一行(同样的事情)来改善我的VBA代码,我将非常感激。 / p>

我先谢谢大家。

以下是我的代码

    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

编辑:感谢您的回答所带来的见解。与我未完成的代码不同,您可以通过短代码使一个简单的任务成为可能。从我的第一篇文章中学到了很多东西。谢谢

2 个答案:

答案 0 :(得分: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

答案 1 :(得分:1)

我采取了与@Jeeped不同的方法,所以我认为我愿意分享,因为我还是花时间来练习您的问题。您只需要使用所需的日期格式来格式化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