如何插入多个日期列以满足特定日期？

Question

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

在工作簿中，我想确保工作表（Sheet1）的工作表（Sheet1）的单元格（I1）具有写入其他工作表（即Menu）中的特定日期。我想让I1成为后续日期将通过横跨行（I1，J1，K1等）发生的起点。在这种情况下，如果我的具体日期是15/8/16，并且我的工作表（工作表1）中的一个将其单元格I1写为20/8/16，我想知道如何以这样的方式构造我的代码，

如果工作表1中的I1当前处于15/8/16，则什么也不做。但是，如果工作表1中的I1的日期与15/8/16不同，那么I1现在将在15/8/16开始，随后的日期将被添加，直到达到I1中最初存在的默认日期（现在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）是我的开始日期，（D7）是我的结束日期。

我的代码当前没有插入列部分，因为我在将插入列和日期增量代码应用在一起时出现问题。使用我当前的代码，我的日期范围从未扩展，因为它仍处于早期日期范围内（与以前相同的最后一列，因此日期列的最后一个单元格保持原样）。我如何构建这样一种方式，即添加两者之间的缺失日期，并通过在重复过程中插入列来添加它们？

在此先感谢，如果有人可以帮助我在这。感谢您的理解。

Answer 1

请检查下面的代码添加列

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 

Answer 2

你可以试试这个：

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 

只是改变“工作”和“菜单”你的实际工作表名称