简体   繁体   中英

VBA Excel separate range of date in cells

This is giving me a headache.. Im trying to do the following:

This is the data I have, I have element's names and a start date and an end date. I want to have this data by day and not in range anymore (So I can upload it to a database I have which is by day).

I dont know if I can do this without using VBA but I guess the quickes would be VBA.

Current data:

╔═══════╦════════════╦════════════╗
║ name  ║ start date ║  end date  ║
╠═══════╬════════════╬════════════╣
║ foo1  ║ 25-11-2013 ║ 28-11-2013 ║
║ foo2  ║ 25-11-2013 ║ 28-11-2013 ║
║ foo3  ║ 25-11-2013 ║ 28-11-2013 ║
║ foo4  ║ 25-11-2013 ║ 28-11-2013 ║
║ foo5  ║ 25-11-2013 ║ 28-11-2013 ║
║ foo6  ║ 28-11-2013 ║ 28-11-2013 ║
║ foo7  ║ 28-11-2013 ║ 28-11-2013 ║
║ foo8  ║ 28-11-2013 ║ 28-11-2013 ║
║ foo9  ║ 28-11-2013 ║ 28-11-2013 ║
║ foo10 ║ 28-11-2013 ║ 28-11-2013 ║
║ foo11 ║ 29-11-2013 ║ 30-11-2013 ║
║ foo12 ║ 29-11-2013 ║ 30-11-2013 ║
║ foo13 ║ 29-11-2013 ║ 30-11-2013 ║
║ foo14 ║ 29-11-2013 ║ 30-11-2013 ║
║ foo15 ║ 29-11-2013 ║ 30-11-2013 ║
╚═══════╩════════════╩════════════╝

And I want to separate de names by day, to obtain this:

╔═══════╦════════════╗
║ name  ║    date    ║
╠═══════╬════════════╣
║ foo1  ║ 25-11-2013 ║
║ foo2  ║ 25-11-2013 ║
║ foo3  ║ 25-11-2013 ║
║ foo4  ║ 25-11-2013 ║
║ foo5  ║ 25-11-2013 ║
║ foo1  ║ 26-11-2013 ║
║ foo2  ║ 26-11-2013 ║
║ foo3  ║ 26-11-2013 ║
║ foo4  ║ 26-11-2013 ║
║ foo5  ║ 26-11-2013 ║
║ foo1  ║ 27-11-2013 ║
║ foo2  ║ 27-11-2013 ║
║ foo3  ║ 27-11-2013 ║
║ foo4  ║ 27-11-2013 ║
║ foo5  ║ 27-11-2013 ║
║ foo6  ║ 28-11-2013 ║
║ foo7  ║ 28-11-2013 ║
║ foo8  ║ 28-11-2013 ║
║ foo9  ║ 28-11-2013 ║
║ foo10 ║ 28-11-2013 ║
║ foo11 ║ 29-11-2013 ║
║ foo12 ║ 29-11-2013 ║
║ foo13 ║ 29-11-2013 ║
║ foo14 ║ 29-11-2013 ║
║ foo15 ║ 29-11-2013 ║
║ foo11 ║ 30-11-2013 ║
║ foo12 ║ 30-11-2013 ║
║ foo13 ║ 30-11-2013 ║
║ foo14 ║ 30-11-2013 ║
║ foo15 ║ 30-11-2013 ║
╚═══════╩════════════╝

Thank you in advance.

Combined with @SorenHoltenHansen's answer, this should get you where you want to go. This class will accept a Start and End date range and it will calculate the full range of dates which you can then use in code.

Create a new class, call it "clsDateRange", and add the following code:

Option Compare Database
Option Explicit

Private m_colDates As Collection

Public Sub InitStartEnd(ByVal dtStart As Date, ByVal dtEnd As Date)
    Set m_colDates = New Collection
    Dim tempDate As Date
    For tempDate = dtStart To dtEnd Step 1
        m_colDates.Add DateValue(tempDate)
    Next
End Sub

Public Property Get Dates() As Collection
    Set Dates = m_colDates
End Property

You can go whole hog and implement the collection interface, but this should be sufficient for your needs. If you are going to have very large date ranges and you want to be smart about it, you could store just the start and end dates and generate the in-between dates only when they are needed, but I wanted to be able to use the For...Each without having to define [_NewEnum] and all of the subproperties of Collection.

Here are a few tests in a module "mdlMain" so you can see how you might use it:

Public Sub Main()
    Dim oDateRange As New clsDateRange
    Dim varDate As Variant

    oDateRange.InitStartEnd "25-11-2013", "27-11-2013"
    For Each varDate In oDateRange.Dates()
        MsgBox varDate
    Next

    oDateRange.InitStartEnd "28-11-2013", "28-11-2013"
    For Each varDate In oDateRange.Dates()
        MsgBox varDate
    Next

    oDateRange.InitStartEnd "29-11-2013", "30-11-2013"
    For Each varDate In oDateRange.Dates()
        MsgBox varDate
    Next

End Sub

Incidentally, dates are actually just 64-bit floating point numbers , Doubles . They represent the range January 1, 100 to December 31, 9999 . Each day is 1, so the entire range is [-657434, 2958465]. Times of day are represented as fractional decimal parts. Midnight is *.0, noon is *.5, 3:30 is ~ *.645833333333333. Currently (in my timezone), it's December 6, 2013 1:27 PM. According to VBA in the immediate window ?CDbl(now()) , that's 41614.5608680556.

So that's the reason why I can run through the date range in a for loop, adding one each time to increment the day.

The fastest and easiest way might be to use VBA. The following code loops through the values from column A and C , writes these underneath the existing data in column A and B and removes data in column C .

Sub SeperateDateRange()
    Dim Ws As Worksheet
    Dim nCol As Integer

    'Define sheet
    Set Ws = ActiveSheet

    nCol = 1 '<~~ Defines the number of columns before the date columns

    Application.ScreenUpdating = False

    'Loops throuh cells
    For i = 1 To ActiveSheet.Cells(Rows.Count, nCol + 2).End(xlUp).Row - 1 Step 1
        For j = 0 To Ws.Cells(i + 1, nCol + 2).Value - Ws.Cells(i + 1, nCol + 1).Value Step 1

            With Ws.Cells(Ws.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
                For k = 0 To nCol - 1 Step 1
                    .Offset(0, k).Value = Ws.Cells(i + 1, k + 1).Value
                Next k
                .Offset(0, nCol).Value = DateSerial(Year(Ws.Cells(i + 1, nCol + 1).Value), Month(Ws.Cells(i + 1, nCol + 1).Value), Day(Ws.Cells(i + 1, nCol + 1).Value) + j)
            End With
        Next j
    Next i

    'Deletes last column with dates
    Ws.Cells(1, nCol + 2).EntireColumn.Delete

    Application.ScreenUpdating = True
End Sub

UPDATE: Because of a follow-up question in the comments, the code is now changed so that the variable nCol defines the number of columns with names before the date columns. If the macro should run on the data presented in the original question, then nCol = 1 . If there are three columns with names before the date viables, then nCol = 3 .

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM