VBA 将列复制到 excel 日历中的匹配日期

Question

我正在尝试为 excel 学习一些 vba 编程，长话短说

我有一台使用 allen bradley plc 的机器，我在 plc 中创建了一个程序来记录每小时运行统计数据，我设法将这些实时更新为 excel sheet, 它每小时上传一次，持续 24 小时。机器运行分 3 班，早上 6 点到下午 2 点，下午 2 点到晚上 10 点，晚上 10 点到早上 6 点。在工厂里，我们每天早上 6 点到早上 6 点 class。

我编写了以下代码，它从 plc 复制值并将它们粘贴到匹配日期，单元格 "c10" 包含 =today() 然后在 sheet 2 上它将粘贴匹配日期下的日历值。

这现在工作正常，但我想更改它，以便在每个日期下它包含早上 6 点到早上 6 点的值，而不是 24 小时的值。

我遇到的问题是单元格 c10（今天的日期）将在凌晨 12 点后更新，因此粘贴目标将发生变化。

这是我的代码

Private Sub work_test()

 'set variables
    Dim Day As Date
    Dim rfound As Range
    Dim frow, fcol As Integer
    Dim sh1, sh2 As Worksheet

'set sheets
    Set sh1 = Sheets("sheet1")
    Set sh2 = Sheets("sheet2")

'sets day as current day, finds matching day in sheet2
     Day = sh1.Range("c10")
           Set rfound = sh2.Range("7:11").Find(Day, LookIn:=xlValues)

           If Not rfound Is Nothing Then

                frow = rfound.Row
                fcol = rfound.Column

                sh1.Range("c11:c34").Copy sh2.Cells(9, fcol)
            Else
                MsgBox "No match found"


           End If
'runs timer
     Call timer

End Sub

Sub timer()
'repeats cell update timer
Application.OnTime Now + TimeValue("00:01:00"), "work_test"
End Sub

希望有人能提供帮助，而不是寻找完整的解决方案，只是在正确的方向上提供一点帮助

谢谢

Answer 1

这是实现您想要的许多方法中的两种：

1.- 将 C10 中的公式替换为以下公式：

   = TODAY() + IF( NOW() - TODAY() < TIME(6,0,0) , -1 , 0 )

上面的公式验证时间，它减去 06:00:00 然后休息一个到日期。因此，午夜和 06 AM 之间的任何时间都将被视为前一天

2.- 在您的代码中替换此行：

   Day = sh1.Range("c10")

有了这个：

   Day = Date + IIf(Time < TimeSerial(6, 0, 0), -1, 0)

和上面第1点一样，只是因为你用的是VBA所以工作表中不需要日期作为公式，机器的日期可以直接在VBA 然后从那里继续。

VBA 将列复制到 excel 日历中的匹配日期

VBA Copying columns to matching date in excel calender

excel

vba

plc