扩展最后一列excelvba

我在下面编写这个宏是为了检查相邻列中的两个日期之间是否存在间隔，然后插入列以填补该间隔

我希望它能够在与工作表上的列数相同的列上运行，但是，由于某些原因，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

Sub-weekendsouts（）
将数据标注为工作表，最后一列的长度为_
DateCell作为范围，DateRange作为范围
设置输出数据=工作表（“输出数据”）
LastColumn=OUTSDATA.UsedRange.Columns.Count
Set DateRange=OUTSDATA.Range（OUTSDATA.Cells（2,8），OUTSDATA.Cells（2,LastColumn）.Address）
对于DateRange中的每个DateCell
带DateCell
如果.Value为“”，则
如果.Offset（0,1）.Value.Value+1和.Offset（0,1）.Value.Value，则
.偏移量（0，1）.entireclumn.Insert
.EntireClumn.Copy目标：=.Offset（-1,1）
.Offset（0，1）.值=.Offset（0，1）.值+1
如果结束
如果结束
以
下一个日期单元格
端接头

实现这一点有很多方法，保留现有代码，我建议进行以下修改，向后工作。使用集合并添加到其中时，集合的大小会更改，但引用仍链接到原始大小。这就是你面临的问题

通过向后工作，您不会受到大小变化的影响

要执行此操作，可以在循环中使用

步骤-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

Sub-weekendsouts（）
将数据标注为工作表，最后一列的长度为_
DateCell作为范围，DateRange作为范围
设置输出数据=工作表（“输出数据”）
LastColumn=OUTSDATA.UsedRange.Columns.Count
Set DateRange=OUTSDATA.Range（OUTSDATA.Cells（2,8），OUTSDATA.Cells（2,LastColumn）.Address）
对于LastColumn=LastColumn到0步骤-1
'对于DateRange中的每个DateCell
Set DateCell=OUTSDATA.Cells（2，最后一列）
带DateCell
如果.Value为“”，则
如果.Offset（0,1）.Value.Value+1和.Offset（0,1）.Value.Value，则
.偏移量（0，1）.entireclumn.Insert
.EntireClumn.Copy目标：=.Offset（-1,1）
.Offset（0，1）.值=.Offset（0，1）.值+1
如果结束
如果结束
以
Set DateCell=Nothing
下一个
Set DateRange=Nothing
设置数据=无
端接头

（这是未经测试的，用作示例以适应）

---

这里发生的事情是，

LastColumn

是10，然后循环从10开始，下一次迭代是9，然后是8，等等。

有很多方法可以实现这一点，保留您拥有的代码，我建议进行以下更改，向后工作。使用集合并添加到其中时，集合的大小会更改，但引用仍链接到原始大小。这就是你面临的问题

通过向后工作，您不会受到大小变化的影响

要执行此操作，可以在循环中使用

步骤-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

Sub-weekendsouts（）
将数据标注为工作表，最后一列的长度为_
DateCell作为范围，DateRange作为范围
设置输出数据=工作表（“输出数据”）
LastColumn=OUTSDATA.UsedRange.Columns.Count
Set DateRange=OUTSDATA.Range（OUTSDATA.Cells（2,8），OUTSDATA.Cells（2,LastColumn）.Address）
对于LastColumn=LastColumn到0步骤-1
'对于DateRange中的每个DateCell
Set DateCell=OUTSDATA.Cells（2，最后一列）
带DateCell
如果.Value为“”，则
如果.Offset（0,1）.Value.Value+1和.Offset（0,1）.Value.Value，则
.偏移量（0，1）.entireclumn.Insert
.EntireClumn.Copy目标：=.Offset（-1,1）
.Offset（0，1）.值=.Offset（0，1）.值+1
如果结束
如果结束
以
Set DateCell=Nothing
下一个
Set DateRange=Nothing
设置数据=无
端接头

（这是未经测试的，用作示例以适应）

---

这里发生的事情是，

LastColumn

是10，然后循环从10开始，下一次迭代是9，然后是8，等等。

您将要使用一个标准来循环，并将LastColumn的

向后循环到8步骤-1

@ScottCraner今天第二次发生在我身上。在阅读你的评论之前，我写下了我的答案！我很快就会因为这件事受到不好的评价：你会想用一个标准来循环，并在8步骤1的最后一列中循环回病房

，这是今天第二次发生在我身上。在阅读你的评论之前，我写下了我的答案！我很快就会因为这个问题得到一个坏名声：sNo问题，如果我给出了一个公式，有人只是复制并粘贴在答案中，没有进一步的解释，我会很生气，但你解释了所说的内容并展示了如何。非常感谢@Gary！这让我走上了正确的道路！从来没有想过像那样向后工作。唯一的问题是我必须稍微调整代码，将所有的
.offset（0,1）
引用更改为
offset（0，-1）
，以解释向后移动的原因。没问题，如果我给出了一个公式，有人只是复制并粘贴在答案中，没有进一步解释，我会发疯的，但你解释了所说的话，并展示了如何做。非常感谢@Gary！这让我走上了正确的道路！从来没有想过像那样向后工作。唯一的问题是我必须稍微调整代码以更改所有的
.offset（0,1）
o