将开始日期更新一天至结束日期,因为记录了日期范围内每天的相关数据

时间:2017-11-14 19:00:51

标签: excel vba excel-vba date

我正在尝试更新日期,同时在单独的工作表上记录每个日期及其各自的z分数。我的excel文件已经设置好,因此当日期更改时,当天的相应z分数会更新。任何人都可以帮我写日期范围内每天编写日期和相应数据的VBA代码吗?理想情况下,我希望代码在excel表单上直接更改时调整开始日期和结束日期。不幸的是,我似乎无法将日期更新一天而不将其预设到特定日期,因为代码的“次日”部分出现了反对的必需错误。

Sub compliedataloop()

Dim wb As Workbook
Set wb = ActiveWorkbook

Dim wsprecip As Worksheet
Set wsprecip = wb.Worksheets("Precip")

Dim wshistoricaldata As Worksheet
Set wshistoricaldata = wb.Worksheets("Historical Data")

Dim nextday As String
Set nextday = wb.wsprecip.Range("CJ4")

wb.wshistoricaldata.Range("C4").Activate
wb.wsprecip.Range("CJ4").Activate
ActiveCell.Copy
wb.wshitoricaldata.Activate
ActiveCell.PasteSpecial
ActiveCell.Offset(1, 0).Activate
wb.wsprecip.Range("CN37").Activate
ActiveCell.Copy
wb.wshistoricaldata.Activate
ActiveCell.PasteSpecial
ActiveCell.Offset(-1, 1).Activate 
wb.wsprecip.Range("CJ4").Activate
nextday.DateAdd = ("d")


Do While Enddate = False

'select, copy and paste first Date from cell CJ5 in "precip" Worksheet to "historicaldata" worksheet
wb.wsprecip.Range(CJ4).Activate
ActiveCell.Copy
wb.wshistoricaldata.Activate
ActiveCell.PasteSpecial
ActiveCell.Offset(1, 0).Activate
wb.wsprecip.Range("CJ4").Activate
nextday.DateAdd = ("d")
'copy new z-score for new date and paste data into "historicaldata" worksheet
wbs.wsprecip.Range("CN37").Activate
ActiveCell.Copy
wb.wshistoricaldata.Activate
ActiveCell.Offset(0, 1).Activate
ActiveCell.PasteSpecial
'reset positioning for next day's date in one cell above and to the right
ActiveCell.Offset(-1, 1).Activate

If Enddate = 2 / 28 / 2018 Then
Enddate = True
End If

End Sub

1 个答案:

答案 0 :(得分:0)

我不知道从哪里开始......

确保您有Option Explicit作为模块中的第一行。它将要求您定义所有变量,这将阻止您随机输入错误(wbs)或使用尚未赋值的变量(Enddate)。

PS请在变量名称的每个单词的开头加上大写字母,以便您可以更轻松地阅读它们,NextDay

您将nextday定义为字符串。字符串不是对象,因此“对象需要发生错误”的原因。

如果您正在做的只是添加一天,则不需要DateAdd功能,只需添加1

您无需使用任何.Activate.copy.PasteSpecial即可将值从一个单元格复制到另一个单元格。

我无法弄清楚你在做什么;特别是你的结束日期。您是否尝试每天运行一次并继续写入下一列?如果是这样,您需要使用以下内容对最后一列进行罚款:

Public Function LastColumn(Optional Row As Integer = 1, Optional Sheet As Excel.Worksheet) As Long
    If Sheet Is Nothing Then Set Sheet = Application.ActiveSheet
    LastColumn = Sheet.Cells(Row, Sheet.Columns.Count).End(xlLeft).Row
End Function

在第4行的最后一个单元格之后将单元格设置为空单元格(偏移量):

Set cell = LastColumn(4, wb.wsHistoricalData).offset(0,1)

无论如何,这是修复后代码粗略看起来的样子......

Option Explicit

Sub ComplieDataLoop()
Dim wb As Workbook
Dim wsPrecip As Worksheet
Dim wsHistoricalData As Worksheet
Dim NextDay As Date
'Dim EndDate As Date???
Dim cell As Range

    Set wb = ActiveWorkbook
    Set wsPrecip = wb.Worksheets("Precip")
    Set wsHistoricalData = wb.Worksheets("Historical Data")
    NextDay = wb.wsPrecip.Range("CJ4")
    'EndDate = ???
    Set cell = wb.wsHistoricalData.Range("C4")

    Do While EndDate < DateSerial( 2018, 2, 28)
        cell = wb.wsPrecip.Range("CJ4")
        Set cell = Offset(-1, 0)
        cell = wb.wsPrecip.Range("CN37")
        'reset positioning for next day's date in one cell above and to the right
        Set cell = Offset(-1, 1)
        'EndDate = ???
    Loop
End Sub