有没有一种方法可以创建一个“置换”宏，您可以在其中输入一组列（A .... Z）并给出选择的替代顺序（例如（B，A，E，D，C，...， Z））？我想这是以前做过的事情，但是令人惊讶的是很难找到任何先例。
最初，我想使用Range().Copy/.Paste以繁琐的方式或类似地使用/复制/粘贴Columns，即：
Columns("C:C").Insert Shift:=xlToRight
Columns("D:D").Cut
Columns("A:A").Insert Shift:=xlToRight
Columns("G:G").Cut
Columns("E:E").Insert Shift:=xlToRight
...
更新：
我确实在这里找到以下代码：
Sub REORDER()
Dim arrColOrder As Variant, ndx As Integer
Dim Found As Range, counter As Integer
'Place the column headers in the end result order you want.
arrColOrder = Array("COLUMN 2", "COLUMN 4", "COLUMN 6", "COLUMN 10", "COLUMN 1", _
"COLUMN 9", "COLUMN 3", "COLUMN 8", "COLUMN 7", "COLUMN 5")
counter = 1
Application.ScreenUpdating = False
For ndx = LBound(arrColOrder) To UBound(arrColOrder)
Set Found = Rows("1:1").Find(arrColOrder(ndx), LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
If Not Found Is Nothing Then
If Found.Column <> counter Then
Found.EntireColumn.Cut
Columns(counter).Insert Shift:=xlToRight
Application.CutCopyMode = False
End If
counter = counter + 1
End If
Next ndx
Application.ScreenUpdating = True
End Sub
在更大的宏中调用此代码的过程是什么？
这样的事情应该会让您入门。如果您打算在不是从第1行开始的表上使用它，它将需要一些我没有时间进行的修订。
Sub Reorder()
Dim dict As Object
Dim rng As Range, c As Integer
Dim colRng As Range
Set dict = CreateObject("Scripting.Dictionary")
Set rng = Application.InputBox("Select table range", "Select Table", Type:=8)
If rng Is Nothing Then Exit Sub
'you should input a comma-delimited list of column letters, e.g., "E,B,C,A,D"
newOrder = Application.InputBox("Specify new order", "New order")
If Not rng.Columns.Count - 1 = UBound(Split(newOrder, ",")) Then
MsgBox "Invalid selection", vbCritical
End If
For Each v In Split(newOrder, ",")
v = Trim(v)
Set colRng = Range(Columns(v).Address).Resize(rng.Rows.Count)
dict(colRng.Address) = colRng.Value
Next
For Each k In dict.Keys()
c = c + 1
rng.Columns(c).Value = dict(k)
Next
Set dict = Nothing
End Sub
本文收集自互联网，转载请注明来源。
如有侵权，请联系[email protected] 删除。
我来说两句