Question

我目前正在处理一个16 000行excel文件，我已经在互联网上检查过去几天，但没有找到任何相关帮助来解决这个问题。

这个想法是2列（H和I）包括最多365行的开始日期和结束日期（对应于365天后）。对于每一行，我想写出从开始日期到结束日期的每个日期。例如，我的前10行包括开始日期01/01/2018和结束日期01/10/2018。对于每一行，我希望每个日期如下：

2018年1月1日
1018年1月2日
2018年1月3日
...
2018年1月10日

我的主要问题是，如果单元格的值等于“结束日期”的日期，它应该停在第10行。（如果这可以提供帮助，我有一个天数＆＃39;列，这是K列中结束日期和开始日期之间的差异）

您将在我当前的代码下方找到。作为一个初学者，它包含了一些错误。你能帮我一下吗？

    Sub Dates()
    Dim FirstDate As Date
    Dim LastDate As Date
    LastRow = sht.ListObjects("Table1").Range.Rows.Count
    FirstDate = Cells("8" & Rows.Count).Value
    LastDate = Cells("9" & Rows.Count).Value
    NbDays = Cells("11" & Rows.Count).Value

    For X = Cells("2" & Rows.Count).End(xlDown) To LastRow
            If FirstDate = LastDate Then
                X = FirstDate

    Else
        Do
            X = FirstDate + 1

        Loop Until X.Value = LastDate

    End Sub

电子表格应如下所示：

    Type    Date     Start date   End Date
    A   01/01/2018  01/01/2018  01/10/2018
    A   01/02/2018  01/01/2018  01/10/2018
    A   01/03/2018  01/01/2018  01/10/2018
    A   01/04/2018  01/01/2018  01/10/2018
    A   01/05/2018  01/01/2018  01/10/2018
    A   01/06/2018  01/01/2018  01/10/2018
    A   01/07/2018  01/01/2018  01/10/2018
    A   01/08/2018  01/01/2018  01/10/2018
    A   01/09/2018  01/01/2018  01/10/2018
    A   01/10/2018  01/01/2018  01/10/2018
    B   02/06/2018  02/06/2018  02/10/2018
    B   02/07/2018  02/06/2018  02/10/2018
    B   02/08/2018  02/06/2018  02/10/2018
    B   02/09/2018  02/06/2018  02/10/2018
    B   02/10/2018  02/06/2018  02/10/2018

我提前感谢你

Answer 1

我会推荐一个FOR循环，利用你可以移动你的球门柱的事实。

现在，由于您尚未对Cells引用进行限定（例如Sheet1.Cells），因此我将创建一个包含数据的新工作表。（始终，始终，始终限定您的工作表，即使它是ActiveSheet.Cells或Me.Cells。它可以帮助您发现所以许多“意外”错误之前他们发生了）

基本上，我们将复制输入数据，添加“日期”列，然后运行填充它的行。如果日期不是结束日期，我们复制行并添加1天 - 这也使循环更长 - 当我们到达循环结束时，我们就完成了。

Sub DailyLines()
    Dim NewSheet As Worksheet
    Dim lWorkingRow As Long, lEndRow As Long
    Set NewSheet = ThisWorkbook.Worksheets.Add

    'Copy Table1 to working sheet
    Union(sht.ListObjects("Table1").HeaderRowRange, _
        sht.ListObjects("Table1").DataBodyRange).Copy Destination:=NewSheet.Cells(1, 1)
    NewSheet.ListObjects(1).Unlist 'Convert table to range - this will mak it easier to work with
    NewSheet.Calculate
    NewSheet.Columns(8).Insert xlShiftRight 'Add a new column at H
    NewSheet.Cells(1, 8).Value = "Date" 'Add a header to the new column
    NewSheet.Calculate

    'This is where the processing starts
    lEndRow = NewSheet.Cells(NewSheet.Rows.Count, 1).End(xlUp).Row 'Find bottom row
    If lEndRow > 1 Then 'At least 1 row of data
        For lWorkingRow = 2 To lEndRow 'Step through rows
            'is this new data?
            If Len(NewSheet.Cells(lWorkingRow, 8).Value) < 1 Then 'Never processed this row before
                NewSheet.Cells(lWorkingRow, 8).Value = NewSheet.Cells(lWorkingRow, 9).Value 'Default to StartDate
            Else 'Not the first copy of the row
                NewSheet.Cells(lWorkingRow, 8).Value = NewSheet.Cells(lWorkingRow, 8).Value + 1 'Increment by 1 day
            End If
            'Have we finished with this data?
            If NewSheet.Cells(lWorkingRow, 8).Value + 1 <= NewSheet.Cells(lWorkingRow, 10).Value Then 'Not reached EndDate
                NewSheet.Rows(lWorkingRow).Copy NewSheet.Rows(lWorkingRow) 'Duplicate the row
                lEndRow = lEndRow + 1 'IMPORTANT!  We now need to process 1 more row of data!
            End If
        Next lWorkingRow
    End If

    'Tidy up
    Set NewSheet = Nothing
End Sub

如何显示列中2个日期之间的所有日期？

1 个答案: