Question

我正在尝试找到一种基于日期自动插入列的方法。以下是一些背景信息：

我的电子表格（第1行）的第一行包含格式为yyyy / mm / dd的日期
日期不是每天;他们是每周一次（即一个单元格可能会说2015/09/21，下一个会说2015/09/28而下一个会说2015/10/05）所以这可能会逐年变化
我需要找到一种方法，在每个季度结束时自动插入一列，在每半季结束时自动插入两列（即3月到4月之间的一列，6月到7月的两个列，9月到10月的一个，和12月到1月之间的两次）

到目前为止，这是我用来遍历顶行并查看日期是在10月之前但是在9月之后。日期从单元格I1开始。虽然代码执行没有任何错误，但实际上并没有做任何事情。我们所能提供的任何帮助将不胜感激。

With Sheets("Sheet1")
    Range("I1").Select
    Do Until IsEmpty(ActiveCell)

        If ActiveCell.Value < DateValue("2015/10/1") And ActiveCell.Offset(0, 1).Value > DateValue("2015/9/28") Then
            Range(ActiveCell).EntireColumn.Insert
        End If

        ActiveCell.Offset(0, 1).Select
    Loop
End With

Answer 1

我认为你的方法开局良好。您应该能够检查一个月中的某一天是否小于或等于7.这应该表明一个月中的第一周。如果该月份为4或10，请插入一列。如果它是1或7，请插入两个。

Dim r As Range
Set r = Range("I1")

Do Until IsEmpty(r)

    If Day(r) <= 7 Then
        Select Case Month(r)
            Case 4, 10
                r.EntireColumn.Insert
            Case 1, 7
                r.Resize(1, 2).EntireColumn.Insert
        End Select
    End If

    Set r = r.Offset(0, 1)

Loop

Answer 2

严格按照标题行中两个单元格的月份变化进行更改可能是最简单的逻辑。

Sub insert_quarter_halves()
    Dim c As Long

    With Worksheets("Sheet8")   'set this worksheet reference properly!
        For c = .Cells(1, Columns.Count).End(xlToLeft).Column To 2 Step -1
            If (Month(.Cells(1, c - 1).Value2) = 3 And Month(.Cells(1, c).Value2) = 4) Or _
               (Month(.Cells(1, c - 1).Value2) = 9 And Month(.Cells(1, c).Value2) = 10) Then
                .Cells(1, c).EntireColumn.Insert
            ElseIf (Month(.Cells(1, c - 1).Value2) = 6 And Month(.Cells(1, c).Value2) = 7) Or _
               (Month(.Cells(1, c - 1).Value2) = 12 And Month(.Cells(1, c).Value2) = 1) Then
                .Cells(1, c).Resize(1, 2).EntireColumn.Insert
            End If
        Next c
    End With

End Sub

插入列时，始终从右向左行进，否则您可能会跳过向前推进的条目。

使用VBA基于日期有条件地插入列

2 个答案: