使用VBA根据date有条件地插入列

我试图find一种方法来自动插入一个基于date的列。 这是一些背景：

• 我的电子表格的第一行（第1行）包含格式为yyyy / mm / dd的date
• date不是每天; 他们是每周（即一个细胞可能会说2015/09/21下一个会说2015/09/28，下一个会说2015/10/05），所以这可以改变每年
• 我需要find一种方法，在每个季度结束时自动插入一列，在每个结束时（即三月到四月的一列，六月到七月的TWO，九月到十月的一，两十二月和一月）

到目前为止，这是我用来穿越第一排，看看这个date是在十月之前，但在九月之后。 date从单元格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

我想你的方法是一个好的开始。 你应该能够检查月份的date是否小于或等于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 

插入列时，总是从右向左移动，否则可能会跳过一个向前推进的条目。