从多个日期循环和拉取数据行

时间:2014-06-11 15:11:38

标签: vba loops nested-loops

并提前感谢您提供的任何帮助。我对VBA很新,这超出了我目前的能力范围。

好的,所以我的原始数据按日期和时间间隔30分钟(A列,B列)。我已经构建了一个循环来查找特定的段(使用开始时间和停止时间的数据行)。我遇到的问题是拉多天的时间表。无论日期如何,代码都会从开始到结束时间拉动整个段。所以我最终得到了一大块需要削减的数据。

这是我目前正在使用的代码。 键:* A2 =开始日期,* B2 =开始时间,* C2 =结束日期,* D2 =结束时间。

'============================================
'    Date/Time lookup in Adjusted Table
'============================================

Sheets("Allotments (ADJ)").Select
i = 1
Do Until Cells(i, 1) = ""

If Cells(i, 1) = Sheets("macros").Range("a2") Then
  Do Until Cells(i, 1) <> Sheets("macros").Range("a2")
    If Cells(i, 2) = Sheets("macros").Range("b2") Then
        startrow = i
    End If
    i = i + 1
  Loop
End If
i = i + 1
Loop

i = 1
Do Until Cells(i, 1) = ""
If Cells(i, 1) = Sheets("macros").Range("c2") Then
   Do Until Cells(i, 1) <> Sheets("macros").Range("c2")
      If Cells(i, 2) = Sheets("macros").Range("d2") Then
        endrow = i
      End If
      i = i + 1
   Loop
End If
i = i + 1
Loop

Sheets("Allotments (ADJ)").Range("a" & startrow & ":l" & endrow).Copy
Sheets("macros").Select
Range("c3").Select
ActiveSheet.Paste
CutCopyMode = False

如果我试图从多个日期范围拉出来,有没有办法可以修改此设置以仅抓取每天的详细时间范围?

1 个答案:

答案 0 :(得分:1)

经过长时间的修补并使变量更加清晰,我得到了一个可行的版本。

StartDate = DateValue(StartDate) EndDate = DateValue(EndDate)

表格(“分配(ADJ)”)。选择

If StartDate = EndDate Then

    datestart = 2
    Do Until Range("A" & datestart) = ""
        If Sheets("Allotments (ADJ)").Range("A" & datestart).Value = StartDate Then

             StartTimerow = datestart
             Do Until Range("B" & StartTimerow).Value = StartTime
                 StartTimerow = StartTimerow + 1
             Loop

              Endtimerow = StartTimerow
              Do Until Range("B" & Endtimerow).Value = EndTime
                Endtimerow = Endtimerow + 1
              Loop

             Exit Do
         End If
        datestart = datestart + 1

     Loop

 Sheets("Allotments (ADJ)").Range("a" & StartTimerow & ":N" & Endtimerow).Copy
 Sheets("Macros").Select
 Range("C1").Select
 Range("c" & Rows.Count).End(xlUp).Offset(1).Select
 ActiveSheet.Paste
 CutCopyMode = False

End Sub