如何插入多个date列以满足特定的date?

我对代码和Excel VBA非常陌生,希望你们能帮我解决我的问题。 任何提示,反馈和意见,非常感谢!

在工作簿中,我想确保工作表(Sheet1)的单元格(I1)具有写入其他工作表(即菜单)中的特定date。 我希望I1成为后续date将通过行(I1,J1,K1等)发生的起点。 在这种情况下,如果我的具体date是15/8/16,并且我的一张表单(Sheet 1)的单元格I1写为20/8/16,我想知道如何构build我的代码,

如果工作表1中的I1现在在15/8/16,则什么也不做。 但是,如果工作表1中的I1与15/8/16之后的date不同,那么I1现在将在15/8/16开始,并且随后的date被添加,直到达到最初在I1处的默认date(现在20/8/16在单元格N1)。

我目前的代码如下:

If ActiveSheet.Range("I1") <> MainSht.Range("D6") Then ActiveSheet.Range("I1") = MainSht.Range("D6") End If Do If Cells(1,z+1)>Cells(1,z+1) Then Cells(1,z+1) = Cells(1,z)+1 End If z = z+1 Loop Until Cells(1,z+1) = MainSht.Range("D7") 

* Mainsht(D6)是我的开始date,(D7)是我的结束date。

我的代码目前没有插入列部分,因为我在将插入列和date增量代码应用在一起的问题。 用我当前的代码,我的date范围从来没有扩大,因为它仍然在同一个较早的date范围内(与之前相同的最后一列,因此date列的最后一个单元格保持原样)。 我如何构build这样一种方式,即添加它们之间的缺失date,并通过在重复过程中插入列来添加它?

在此先感谢,如果有人能帮助我在这个。 感谢您的理解。

请检查下面的代码添加列

 Dim start_date, end_date As Date start_date = ThisWorkbook.Sheets("Sheet1").Range("L1").Value end_date = ThisWorkbook.Sheets("main").Range("D7").Value If start_date < end_date Then Do Until start_date = end_date ThisWorkbook.Sheets("Sheet1").Activate Range("L:L").Insert (xlRight) start_date = start_date + 1 Range("L1").Value = start_date Loop End If 

你可以试试这个:

 Option Explicit Sub main() Dim diff As Long With Worksheets("Work").Range("I1") '<--| reference working sheet range "I1" (change "Work" to your actual working worksheet) diff = .Value - Worksheets("Menu").Range("D6") ' <--| evaluate the difference between referenced range value and worksheet "Menu" cell "D6" (change "Menu" to your actual "main" sheet) If diff > 0 Then With .Resize(, diff) '<-- reference referenced range resized to the necessary columns number .EntireColumn.Insert xlRight '<-- insert columns With .Offset(, -diff).Resize(1) '<--| reference referenced range first row .FormulaR1C1 = "=RC[1]-1" ' <--| insert formulas that substracts one from the value of next cell on the right .Value = .Value '<-- get rid of formulas .NumberFormat = .Offset(, diff).Resize(, 1).NumberFormat '<--| format cells as the passed range .EntireColumn.AutoFit '<--| adjust columns width End With End With End If End With End Sub 

只需将“工作”和“菜单”更改为实际的工作表名称即可