扩展最后一列Excel VBA

Question

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

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

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

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

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

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

为此使用可循环使用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 

（这是未经测试，作为一个例子来适应）

这里发生的事情是LastColumn是10，然后循环从10开始，并且下一次迭代直到9，然后是8等...