从日期x开始并在日期y结束时创建单元格

时间:2013-08-16 13:39:59

标签: excel excel-vba excel-2003 vba

我有一个我正在处理的Excel电子表格,它根据日期/时间从数据库中查找数据。我有一个设置了开始日期/时间的行,想要创建一个自动复制该行的脚本或宏,我将其称为引导行,并添加x分钟直到它到达结束时间。

我需要复制整个引导行(第5行)添加x分钟(您可以在单元格D3中定义)并复制它们多次,直到时间值(位于每行的G列)等于结束时间(位于G2)。

1 个答案:

答案 0 :(得分:0)

在OP期间OP提出的转移答案无法发布自己的答案:

以下是我在问题中的有用链接中编写的代码:

Sub PopCells()
' Define Variables
Dim RowLast As Long 'Last Row with Data in it
Dim CpRange As String 'Holds range of data to select when using a variable

' Find the Last Row with Data in it
RowLast = ActiveSheet.Cells(Rows.Count, "H").End(xlUp).Row

' Clear out old range of data
Let CpRange = "H6:ZZ" & RowLast
ActiveSheet.Range(CpRange).Select
Selection.ClearContents

' Set the current row to the first row with Data
CrRow = 5

' Loop copies the current row, pastes it to the following row
' And increments the time frame by the time increament value
While Cells(CrRow, "H") <= [G2]
    ' Select the entire current row
    Let CpRange = "H" & CrRow & ":" & "ZZ" & CrRow
    ActiveSheet.Range(CpRange).Select

    'Copy Selected Row
    Selection.Copy

    ' Increment to the Next Row
    CrRow = CrRow + 1

    ' Select the entire current row
    Let CpRange = "H" & CrRow & ":" & "ZZ" & CrRow
    ActiveSheet.Range(CpRange).Select
    ' Paste in copied row
    ActiveSheet.Paste

    ' Update time
    ActiveSheet.Cells(CrRow, "H") = ActiveSheet.Cells(CrRow - 1, "H") + [$D$3] / 1440
Wend


End Sub