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

我正试图学习一些vba编程的excel，长话短说

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

我编写了以下代码，将plc中的值复制并粘贴到匹配日期，单元格“c10”contains=today（），然后在第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

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

---

谢谢

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

1.-将

C10

中的公式替换为以下公式：

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

为此：

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

Day=Date+IIf（时间<时间序列（6,0,0），-1,0）

与上面第1点相同，只是因为您使用VBA，所以不需要在工作表中将日期作为公式，可以直接在VBA中获取机器的日期并从中继续

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