如何在Excel中使用VBA分割日期

时间:2013-06-20 10:32:57

标签: excel vba excel-vba

当再次使用excel时遇到这样的问题......

我有一个带有这种cloumns的excel表

People    Date
-------------------------
A         01/01/2013 - 05/01/2013
B         03/05/2013
C         08/06/2013

我想要制作什么(例如A)

People    Individual Date
-------------------------
A         01/01/2013  
A         02/01/2013  
A         03/01/2013  
A         04/01/2013  
A         05/01/2013

这一年将在2013年保持不变,月份也或多或少保持不变。

有人可以就如何实现这个目标提出想法吗?

2 个答案:

答案 0 :(得分:0)

理论:检查细胞的长度。如果单元格长度超过10个字符,请使用SPLIT函数获取2个日期。将月份设置为等于变量,并根据这些月份进行循环以计算它们之间的日期。您可能会将这些日期存储在数组中。然后将数组写入电子表格并移至下一个单元格以启动该过程。

编辑:

Sub prSplit()

    If len(ActiveCell.Value) > 10 Then

    Dim arr() As String

    arr = Trim(Split(ActiveCell.Value, "-"))
    For i = LBound(arr) To UBound(arr)
        MsgBox arr(i)
    Next

    End If
End Sub 

你可以从这开始并调整代码直到你得到它。我只是没有时间做整件事。抱歉。 :O(

答案 1 :(得分:0)

Sub ExpandDates()

    Dim rCell As Range
    Dim i As Long
    Dim vaDates As Variant
    Dim rNext As Range

    'Loop through the cells that contain dates or date ranges
    For Each rCell In Sheet1.Range("B2:B4").Cells

        'If there's a space, hyphen, space in the cell, it's a date range
        If InStr(1, rCell.Value, " - ") > 0 Then

            'Split the cell contents on space, hyphen, space
            vaDates = Split(rCell.Value, " - ")

            'Loop through the days of the range of dates
            For i = CDate(vaDates(0)) To CDate(vaDates(1))

                'Find the next blank cell in column E to record the results
                Set rNext = Sheet1.Cells(Sheet1.Rows.Count, 5).End(xlUp).Offset(1, 0)

                'Write column A to column E
                rNext.Value = rCell.Offset(0, -1).Value

                'Create a new date in column B using the month that the loop is currently processing
                rNext.Offset(0, 1).Value = CDate(i)
            Next i

        'If no hyphen, it's just a date, so create one line in column E
        Else
            Set rNext = Sheet1.Cells(Sheet1.Rows.Count, 5).End(xlUp).Offset(1, 0)
            rNext.Value = rCell.Offset(0, -1).Value
            rNext.Offset(0, 1).Value = rCell.Value
        End If
    Next rCell

End Sub