扩展最后一列Excel VBA

我在下面写了这个macros来检查相邻列中两个date之间是否有空格，然后插入列来填补这个空白。

我希望它能够在工作表上尽可能多的列上运行它，但由于某种原因，DateRange被卡在工作表的初始大小上，并且不考虑macros添加的附加列。 我从来没有遇到过这个问题，所以我很难过！

那里的任何人都知道我能做些什么来解决这个问题？

Sub weekendsouts() Dim OUTSDATA As Worksheet, LastColumn As Long, _ DateCell As Range, DateRange As Range Set OUTSDATA = Worksheets("OUTS DATA") LastColumn = OUTSDATA.UsedRange.Columns.Count Set DateRange = OUTSDATA.Range(OUTSDATA.Cells(2, 8), OUTSDATA.Cells(2, LastColumn).Address) For Each DateCell In DateRange With DateCell If .Value <> "" Then If .Offset(0, 1).Value <> .Value + 1 And .Offset(0, 1).Value <> .Value Then .Offset(0, 1).EntireColumn.Insert .EntireColumn.Copy Destination:=.Offset(-1, 1) .Offset(0, 1).Value = .Offset(0, 1).Value + 1 End If End If End With Next DateCell End Sub 

Answer 1

有很多方法可以实现这一点，保留你有的代码，我会build议下面的修改，反向工作。 当您使用集合并添加集合时，集合的大小会发生变化，但您的引用仍与原始大小相关联。 这是你遇到的问题。

通过反向工作，你不会受到尺寸变化的影响。

要做到这一点使用可以在循环中使用Step -1 ，如下所示： –

 Sub weekendsouts() Dim OUTSDATA As Worksheet, LastColumn As Long, _ DateCell As Range, DateRange As Range Set OUTSDATA = Worksheets("OUTS DATA") LastColumn = OUTSDATA.UsedRange.Columns.Count Set DateRange = OUTSDATA.Range(OUTSDATA.Cells(2, 8), OUTSDATA.Cells(2, LastColumn).Address) For LastColumn = LastColumn to 0 Step - 1 'For Each DateCell In DateRange Set DateCell = OUTSDATA.Cells(2,LastColumn) With DateCell If .Value <> "" Then If .Offset(0, 1).Value <> .Value + 1 And .Offset(0, 1).Value <> .Value Then .Offset(0, 1).EntireColumn.Insert .EntireColumn.Copy Destination:=.Offset(-1, 1) .Offset(0, 1).Value = .Offset(0, 1).Value + 1 End If End If End With Set DateCell = Nothing Next Set DateRange = Nothing Set OUTSDATA = Nothing End Sub 

（这是未经testing的，用作适应的例子）

这里发生的是LastColumn是10然后循环开始在十，下一个迭代是直到9，然后8等…