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

时间:2016-10-02 04:19:50

标签: excel vba excel-vba date

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

在工作簿中,我想确保工作表(Sheet1)的单元格(I1)具有写在不同工作表(即菜单)中的特定日期。我希望I1成为后续日期将通过行(I1,J1,K1等)发生的起点。在这种情况下,如果我所需的特定日期是15/8/16并且我的一张表(Sheet 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)是我的结束日期。

我的代码目前没有插入列部分,因为我在同时应用插入列和日期增量代码时遇到问题。使用我当前的代码,我的日期范围从未扩展,因为它仍然在相同的早期日期范围内(与之前相同的最后一列,因此日期列的最后一个单元格保持原样)。如何以这样的方式构造,即添加缺少的日期,并通过在重复的过程中插入列来添加它?

如果有人能帮我解决这个问题,请提前致谢。谢谢你的理解。

2 个答案:

答案 0 :(得分: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

答案 1 :(得分:0)

你可以试试这个:

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

只需改变&#34;工作&#34;和&#34;菜单&#34;到你的实际工作表名称