vba - 如何在 Excel 中使用 VB 拆分日期

Question

再次与excels打交道时遇到这样的问题......

我有一个带有这样的 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 年保持不变，月份也或多或少保持不变。

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

Answer 1

理论：检查单元格的长度。如果单元格长度超过 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(

Answer 2

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