将动态列向右移动 VBA（Object 要求的错误）

Question

我正在尝试 select 基于标题值的列，然后将它们移到右侧的末尾。我知道它 select 正确设置了列，并确定了下一个空列。但是，当运行代码时，它会下降到 emptyRange.select.offset，然后给出一个错误，指出需要 object。

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

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 做什么。您没有为行 up/down 或列 left/right 指定参数，所以它实际上什么也没做。另外，我认为您不能在这样的 select 语句之后使用它。如果你想这样做，你会这样做：

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

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

emptyRange.Offset(0,1)

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

无需遍历 A1:ZZ1 中的所有单元格，只需再次使用 Find 方法即可。这样做的另一个好处是，像我在下面所做的那样使用查找将始终 return 一个对象（在 excel 2007 年及以后），因此您不需要像我上面提到的那样进行检查。

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

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

OP 发布后编辑 "sloppy solution":

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

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

将动态列向右移动 VBA（Object 要求的错误）

Shifting Dynamic Columns to the Right VBA (Object req'd error)

excel

vba

dynamic-columns