将dynamic列移动到正确的VBA（对象请求错误）
我正在尝试根据标题值select列，然后将它们移到最后。 我知道这是正确select列，并确定下一个空列。 但是，在运行代码时，它会回到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 下面马虎的解决scheme
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
几个我看到的问题。
1）在尝试访问emptyRange之前，您没有检查emptyRange是否与对象引用一起分配。 现在，您的工作表的数据宽度可能永远不会超过列“ZZ”，但这不是一个好的做法。 这可能是你的问题，但它可能不是 – 我不能不知道你的数据。
2）我没有看到你在这里用Offset做什么。 您还没有为上/下行或左/右列指定参数，所以它没有任何作用。 另外，我不认为你可以在像这样的select语句后使用它。 如果你想这样做，你会做：
emptyRange.Select Selection.Offset(0,1) `this would offset one column - not sure what you wanted to do
但是整个select步骤是不必要的，因为您可以直接使用对象：
emptyRange.Offset(0,1)
至于你是否过于复杂的事情是的 – 你可以通过摆脱所有的Activate＆Select方法，直接使用对象来简化这个代码。
不要循环遍历A1：ZZ1中的所有单元格，只需再次使用Find方法即可。 这样做的另一个好处是，使用查找，如我以下所做的将始终返回一个对象（在Excel 2007和以上），所以你不会需要像我上面提到的检查。
我不是特别喜欢用两个查询语句为dCol和qCol创build一系列使用的数据 – 我发现很难阅读和解释你在做什么。 在这里，我再也不会像上面提到的那样使用固定大小的范围了 – 这会让你的代码变得更加脆弱。 实际上，如果将其分解为两个操作，读者可以更容易理解：1）find列，2）将列的大小调整到列的最后一行
您可以通过使用“偏移量”仅移动一列来避免第二个循环，并且可以通过提供剪切的目标参数来消除insert行。
OP之后编辑贴出“马虎的解决scheme”：
只需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