将动态列向右移动 VBA（对象要求错误）

Question

我正在尝试根据标题值选择列，然后将它们移到右侧的末尾。我知道它正在正确选择列，并识别下一个空列。但是，在运行代码时，它会下降到 emptyRange.select.offset，然后给出一个错误，指出需要一个对象。

我不确定我是否让这段代码过于复杂。

Sub colShift()
Dim dCol As Range
Dim qCol As Range
Dim emptyRange As Range

    With Sheets("Data")

        Set dCol = Range( _
        Range("A1:ZZ1").Find(What:="name_a", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
        xlWhole, MatchCase:=False), _
        Range("A1:ZZ1").Find(What:="name_a", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
        xlWhole, MatchCase:=False).End(xlDown))

        Set qCol = Range( _
        Range("A1:ZZ1").Find(What:="name_b", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
        xlWhole, MatchCase:=False), _
        Range("A1:ZZ1").Find(What:="name_b", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
        xlWhole, MatchCase:=False).End(xlDown))

    End With

    For Each cell In Range("A1:ZZ1")
        cell.Activate
            If IsEmpty(cell) = True Then
                Set emptyRange = ActiveCell
            Exit For
        End If
    Next cell

    dCol.Select
    Selection.Cut
    emptyRange.Select.Offset
    Selection.Insert Shift:=xlToRight

    For Each cell In Range("A1:ZZ1")
        cell.Activate
            If IsEmpty(cell) = True Then
                Set emptyRange = ActiveCell
            Exit For
        End If
    Next cell

    qCol.Select
    Selection.Cut
    emptyRange.Select
    Selection.Insert Shift:=xlToRight

End Sub

下面的草率解决方案

    Sub colShift()
Dim dCol As Range
Dim qCol As Range
Dim emptyRange As Range
Dim MyRange As Range
Dim iCounter As Long

    With Sheets("Data")

        Set dCol = Range( _
        Range("A1:ZZ1").Find(What:="name_a", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
        xlWhole, MatchCase:=False), _
        Range("A1:ZZ1").Find(What:="name_a", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
        xlWhole, MatchCase:=False).End(xlDown))

        Set qCol = Range( _
        Range("A1:ZZ1").Find(What:="name_b", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
        xlWhole, MatchCase:=False), _
        Range("A1:ZZ1").Find(What:="name_b", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
        xlWhole, MatchCase:=False).End(xlDown))

    End With

    For Each cell In Range("A1:ZZ1")
        cell.Activate
            If IsEmpty(cell) = True Then
                Set emptyRange = ActiveCell
                col = ActiveCell.Column
            Exit For
        End If
    Next cell

    dCol.Select
    Selection.Cut
    Cells(1, col).Select

     ActiveSheet.Paste

    'Blank Column Deleter
    Set MyRange = ActiveSheet.UsedRange

    For iCounter = MyRange.Columns.Count To 1 Step -1
       If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then
       Columns(iCounter).Delete
       End If
    Next iCounter

    '
     For Each cell In Range("A1:ZZ1")
        cell.Activate
            If IsEmpty(cell) = True Then
                Set emptyRange = ActiveCell
                col = ActiveCell.Column
            Exit For
        End If
    Next cell

    qCol.Select
    Selection.Cut
    Cells(1, col).Select

     ActiveSheet.Paste

    'Blank Column Deleter
    Set MyRange = ActiveSheet.UsedRange

    For iCounter = MyRange.Columns.Count To 1 Step -1
       If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then
       Columns(iCounter).Delete
       End If
    Next iCounter

End Sub

Answer 1

我看到了几个问题。
1) 在尝试访问之前，您没有检查 emptyRange 是否分配有对象引用。现在，您的工作表可能永远不会有超过列“ZZ”的数据宽度，但这不是一个好习惯。这可能是您的问题，但也可能不是 - 如果没有看到您的数据，我将无法判断。

2) 我看不出你想用Offset 做什么。您没有为向上/向下行或向左/向右列指定参数，因此它实际上没有做任何事情。另外，我认为您不能在这样的 select 语句之后使用它。如果你想这样做，你会这样做：

emptyRange.Select
Selection.Offset(0,1) `this would offset one column - not sure what you wanted to do

但是整个选择步骤是不必要的，因为您可以直接使用对象：

emptyRange.Offset(0,1)

---

至于您是否使事情过于复杂：是的 - 您可以通过摆脱所有激活和选择方法并直接使用对象来简化此代码。

不要循环遍历 A1:ZZ1 中的所有单元格，只需再次使用 Find 方法。这样做的另一个好处是，像我在下面所做的那样使用 find 将始终返回一个对象（在 excel 2007 及更高版本中），因此您不需要像我上面提到的那样进行检查。

我并不特别喜欢使用两个 find 语句来为 dCol 和 qCol 创建一系列使用过的数据 - 我发现很难阅读和解释你在做什么。再一次，我不会像上面提到的那样使用固定大小的范围 - 这会使您的代码更加脆弱。实际上，我认为如果将其分为两个操作，则更容易阅读和理解：1）查找列，2）将范围调整到列中的最后一行

您可以通过使用 Offset 仅移动一列来避免第二个循环，并且您可以通过为 cut 提供目标参数来消除 insert 行。

---

在 OP 发布“草率的解决方案”后编辑：

只需选择整个列并将其插入到最后一个空列之前，就可以大大简化代码。然后，您不需要任何例程来清理空白列。

Sub colShift()
    Dim dCol As Range
    Dim qCol As Range
    Dim destination As Range

    With Sheets("Data").Cells
        'Find the cell in row 1 which contains "name_a"
        Set dCol = .Find(What:="name_a", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, MatchCase:=False).EntireColumn
        'Repeat same steps for qCol
        Set qCol = .Find(What:="name_b", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, MatchCase:=False).EntireColumn
        'Find the last column which has data in it, and get the next column over (the first empty column)
        Set destination = .Find("*", .Cells(1, 1), xlFormulas, xlPart, xlByColumns, xlPrevious).Offset(0, 1).EntireColumn
    End With

    'Insert dCol before the first empty column at the end of the data range:
    dCol.Cut
    destination.Insert shift:=xlShiftToRight

    'Insert qCol before that same empty column
    qCol.Cut
    destination.Insert shift:=xlShiftToRight

End Sub