如何插入多個日期列以滿足特定日期？

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 

只是改變「工作」和「菜單」你的實際工作表名稱