将数据从位于两个时间帧之间的一张纸复制到多张其他纸张

Question

我试图尽可能地自动化。

基本上我希望做到以下几点：

A）在“详细信息”选项卡的AR栏中，确定时间是否介于上午12:01至上午8:59，上午9:00和上午11:59，中午12:00和下午4:59，下午5:00之间和下午7:59，晚上8点和凌晨12:00。

B）一旦我确定了每一组，我只需要将匹配的行，但只有AQ列复制到每个结果的不同表格。

基本上＆gt;

• 确定上午12:01 - 7:59并将A：AQ复制到早期
• 确定上午8:00 - 上午11:59并将A：AQ复制到上午
• 确定12:00 pm - 4:59 pm并将A：AQ复制到 下午
• 确定下午5:00 - 晚上7:59并复制A：这些项目的AQ 开车时间
• 确定晚上8点至凌晨12:00，复制A：AQ 物品到夜晚

我似乎无法让If选择正确。

---

我很好奇，在你的代码中......晚上之后有标签（抱歉，这是晚上，我原来称之为夜晚）。这会引起问题吗？它看起来像“早期”标签一样完美。但它根本没有触及任何其他标签。好像它会停止骑自行车。有大量数据与详细信息中的其他选项卡相匹配。所以我觉得我们几乎就在那里，但只是错过了一件必不可少的作品。谢谢你坚持托尼！

我试过的是

当前代码

Option Explicit
Sub CopyByTime()

  Const RowDtlDataFirst As Long = 2

  Dim HourCrnt As Long
  Dim InxSht As Long
  Dim Limit() As Variant
  Dim RowDtlCrnt As Long
  Dim RowDtlLast As Long
  Dim RowDestNext() As Long
  Dim ShtDest() As Variant

  ' * ShtDest names the five sheets
  ' * For the first four elements, Limit(N) is the maximum hour for
  '   ShtDest(N).  Any row not copied to one of the first four sheets
  '   is copied to the last sheet.
  ShtDest = Array("Early", "Morning", "Afternoon", "Drive Time", "Evening")
  Limit = Array(9, 12, 15, 20)
  ReDim RowDestNext(0 To UBound(ShtDest))

  ' * Find last used row in each destination sheet and set next row to one more.
  ' * You start copy at row 2 and use the same variable for all destination
  '   sheets. This have a different variable for each sheet and adds new data
  '   under any existing data.  This is what I would want.  Adjust to your
  '   requirements.
  For InxSht = 0 To UBound(ShtDest)
    With Worksheets(ShtDest(InxSht))
      RowDestNext(InxSht) = .Cells(Rows.Count, "A").End(xlUp).Row + 1
    End With
  Next

  With Worksheets("Detail")
    ' First last row with a value in the data column.
    RowDtlLast = .Cells(Rows.Count, "A").End(xlUp).Row

    For RowDtlCrnt = RowDtlDataFirst To RowDtlLast
      HourCrnt = Hour(.Cells(RowDtlCrnt, "AX").Value)
      For InxSht = 0 To UBound(ShtDest) - 1
        If HourCrnt < Limit(InxSht) Then
          Exit For
        End If
      Next
      ' If HourCrnt is less than one of the values in Limit, the For-Loop
      ' will have been exited with InxSht identifying the required sheet.
      ' If HourCrnt is not less than one of the values in Limit, InxSht
      ' will be one more than the For-Loop's end value = UBound(ShtDest) -1 + 1

      .Range(.Cells(RowDtlCrnt, "A"), .Cells(RowDtlCrnt, "AQ")).Copy _
         Destination:=Worksheets(ShtDest(InxSht)).Cells(RowDestNext(InxSht), "A")
      RowDestNext(InxSht) = RowDestNext(InxSht) + 1

    Next

  End With

End Sub

问题已通过以下代码解决。最终发生的事情是其他工作表中有剩余数据，因此确定第一条“清晰”线在2000行左右。一旦我弄清楚这一点，它就能很好地发挥作用。

谢谢！

Answer 1

回应2014-12-15 20:46:36Z的评论更新及修订问题

我好奇，在你的代码中......晚上之后有标签（对不起，这是晚上，我原来称之为夜晚）。这会引起问题吗？我不明白;晚上/晚上之后有什么标签？

我使样本比实际文档小很多。我试图提供我正在使用的实际工作表的模拟减去所有额外的。我理解试图消除隐藏真正问题的复杂性。我的困惑在于你在问题中提到了A到AQ列。在第三条评论中，您可以参考K列和A列：G。

...在＆＃34;早期＆＃34;之后停止工作表格似乎没有继续循环。我的代码不做＆＃34;早期＆＃34;然后＆＃34;早上＆＃34; ＆＃34;下午＆＃34;所以我不知道在“早期”工作表之后它会如何失败。

我的代码与我的数据一样有效。我的数据与您的数据不符，或者我对您的要求的理解是错误的。

我的代码不会清除工作表＆＃34;早期＆＃34;，＆＃34;早上＆＃34;，＆＃34;下午＆＃34;，＆＃34; DriveTime＆＃34;或者＆＃34;夜晚＆＃34 ;;它增加了任何现有数据的底部。这种误解很容易解决。你说清楚的列A：G。 H列以后怎么样？可以仅清除选定的列，但清除所有列也很容易。您希望保留列H中的数据吗？

我在A列而不是列AR中有我的日期和时间。再次，这是一个容易解决的误解。

代码按照＆＃34;细节＆＃34;工作表从第2行到最后一行，在A列中有一个值。这可能无关紧要，但也许应该切换到AR列。

对于每一行，循环从日期/时间中提取小时，然后使用数组ShtDest和Limit对时间进行分类：

Array index      0       1         2           3           4
ShtDest        Early   Morning   Afternoon   DriveTime   Night
Limit            8       12       15          20

分类是：

• 如果小时＆lt;限制（0）然后目标工作表是ShtDest（0）=＆＃34;早期＆＃34;
• ElseIf Hour＆lt;限制（1）然后目的地工作表是ShtDest（1）=＆＃34;早上＆＃34;
• ElseIf Hour＆lt;限制（2）然后目标工作表是ShtDest（2）=＆＃34;下午＆＃34;
• ElseIf Hour＆lt;限制（3）然后目标工作表是ShtDest（3）＆＃34; DriveTime＆＃34;
• 其他目的地工作表是ShtDest（4）=＆＃34; Night＆＃34;

列A：详细信息行中的AQ将被复制到目标工作表中的下一个空闲行。

可能有更好的方法来实现这一结果，但我认为这是最简单的。

上面描述了代码应该做什么以及它在我的笔记本电脑上用我的数据做了什么。请更详细地解释您的计算机上有mu数据的情况。

原始发布

我不确定你在尝试测试的是什么，但我确信你误解了Excel如何保存日期和时间。 VBA可以使用＃mm / dd / yy＃形式的文字设置日期，但这不是Excel保存日期的方式。

这与我的解决方案无关，但Excel将日期和时间保存为双打。整数部分是自1900年以来的天数。分数部分是SecondsSinceMidnight / SecondsInADay。尝试创建一列日期，然后将其格式化为数字。或尝试相反。一旦Excel存储了数字或日期，它只能通过查看数字格式知道它是什么。

我认为我的方法在宏观中已得到充分解释，但如果有任何不清楚的地方，我们会回答问题。

我创建了一个包含工作表“Detail”，“Early”，“Morning”等工作簿。

我用数据填写工作表“详细信息”，所以：

通过添加12月1日至9日范围内的日期以及00:00:00至23:51:00范围内的时间创建日期/时间，然后按升序排序。 B列到AQ列填充了行号+列号的值，因此我可以匹配源数据和目标数据。

在每个目标工作表中，我在A列中放置了“Existing”一词来表示现有数据。这是工作表“下午”：

运行宏后，工作表“Afternoon”看起来像：

图像并不像我想的那样清晰。我将尝试创建一些更好的图像，然后更新这个答案，

我相信这个宏是你所寻求的：

Option Explicit
Sub CopyByTime()

  Const RowDtlDataFirst As Long = 2

  Dim HourCrnt As Long
  Dim InxSht As Long
  Dim Limit() As Variant
  Dim RowDtlCrnt As Long
  Dim RowDtlLast As Long
  Dim RowDestNext() As Long
  Dim ShtDest() As Variant

  ' * ShtDest names the five sheets
  ' * For the first four elements, Limit(N) is the maximum hour for
  '   ShtDest(N).  Any row not copied to one of the first four sheets
  '   is copied to the last sheet.
  ShtDest = Array("Early", "Morning", "Afternoon", "DriveTime", "Night")
  Limit = Array(8, 12, 15, 20)
  ReDim RowDestNext(0 To UBound(ShtDest))

  ' * Find last used row in each destination sheet and set next row to one more.
  ' * You start copy at row 2 and use the same variable for all destination
  '   sheets. This have a different variable for each sheet and adds new data
  '   under any existing data.  This is what I would want.  Adjust to your
  '   requirements.
  For InxSht = 0 To UBound(ShtDest)
    With Worksheets(ShtDest(InxSht))
      RowDestNext(InxSht) = .Cells(Rows.Count, "A").End(xlUp).Row + 1
    End With
  Next

  With Worksheets("Detail")
    ' First last row with a value in the data column.
    RowDtlLast = .Cells(Rows.Count, "A").End(xlUp).Row

    For RowDtlCrnt = RowDtlDataFirst To RowDtlLast
      HourCrnt = Hour(.Cells(RowDtlCrnt, "A").Value)
      For InxSht = 0 To UBound(ShtDest) - 1
        If HourCrnt < Limit(InxSht) Then
          Exit For
        End If
      Next
      ' If HourCrnt is less than one of the values in Limit, the For-Loop
      ' will have been exited with InxSht identifying the required sheet.
      ' If HourCrnt is not less than one of the values in Limit, InxSht
      ' will be one more than the For-Loop's end value = UBound(ShtDest) -1 + 1

      .Range(.Cells(RowDtlCrnt, "A"), .Cells(RowDtlCrnt, "AQ")).Copy _
         Destination:=Worksheets(ShtDest(InxSht)).Cells(RowDestNext(InxSht), "A")
      RowDestNext(InxSht) = RowDestNext(InxSht) + 1

    Next

  End With

End Sub