Преобразование одной строки (имя, дата начала, дата окончания) в несколько строк

Question

У меня есть несколько строк данных с 3 столбцами (имя, дата начала, дата окончания), и я хотел бы преобразовать их в одну строку в день.

Я попытался записать макрос (вставить nстрок), но у меня возникли проблемы с зацикливанием.

Answer 1

Это можно легко сделать с помощью Power Query aka Get & Transform, доступного в Excel 2010+. Все это можно сделать с помощью графического интерфейса пользователя (за исключением ввода формулы для настраиваемого столбца)

• ИзТаблица / Диапазон
• Установите тип данных для столбцов даты на whole number
• Добавьте пользовательский столбец, состоящий из серии чисел от Start до End, в качестве списка
  • ={[Start]..[End]}
• Извлечь в строки
• Удалить начальный и конечный столбцы
• Установить тип данных Дата

М-код

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Name", type text}, {"Start", Int64.Type}, {"End", Int64.Type}}),
    #"Added Custom" = Table.AddColumn(#"Changed Type", "Dates", each {[Start]..[End]}),
    #"Expanded Dates" = Table.ExpandListColumn(#"Added Custom", "Dates"),
    #"Removed Columns" = Table.RemoveColumns(#"Expanded Dates",{"Start", "End"}),
    #"Changed Type1" = Table.TransformColumnTypes(#"Removed Columns",{{"Dates", type date}})
in
    #"Changed Type1"

Answer 2

Если вы используете две таблицы и используете Sheet1 в качестве источника и Sheet2 в качестве места назначения, то с помощью вложенного цикла For выполните то, что вы ожидаете:

Sub Process_Dates()
Dim wsSource As Worksheet: Set wsSource = ThisWorkbook.Worksheets("Sheet1")
Dim wsDestination As Worksheet: Set wsDestination = ThisWorkbook.Worksheets("Sheet2")
'declare and set the worksheets you are working with, amend as required

LastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A, from Source worksheet

For i = 2 To LastRow
    strName = wsSource.Cells(i, "A").Value
    StartD = wsSource.Cells(i, "B").Value
    EndD = wsSource.Cells(i, "C").Value
    xDays = DateDiff("d", StartD, EndD)
    'get the number of days between Start Date and End Date
    For x = 0 To xDays
    'loop through the number of days between Start and End
        NextRow = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
        'get the next available row on Destination worksheet
        wsDestination.Cells(NextRow, 1).Value = strName
        wsDestination.Cells(NextRow, 2).Value = DateAdd("d", x, StartD)
    Next x
Next i
End Sub

UPDATE:

Если вместо перемещения данных в другой лист вам нужно вставить строки в тот же лист, то следующий результат даст желаемый результат:

Sub Process_Dates()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
'declare and set the worksheet you are working with, amend as required

LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
i = 2
'set variable to iterate through rows starting with Row 2
While i <= LastRow
    strName = ws.Cells(i, "A").Value
    StartD = ws.Cells(i, "B").Value
    EndD = ws.Cells(i, "C").Value
    xDays = DateDiff("d", StartD, EndD)
    'get the number of days between Start Date and End Date
    For x = 1 To xDays
    'loop through the number of days between Start and End
        ws.Rows(i + x).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        'get the next available row on Destination worksheet
        ws.Cells(i + x, 1).Value = strName
        ws.Cells(i + x, 2).Value = DateAdd("d", x, StartD)
        LastRow = LastRow + 1
        'increment LastRow as new row has been inserted
    Next x
    i = (i + xDays) + 1
    'increment the i variable to go to the next row to split
Wend
End Sub