Question

有没有办法创建一个'置换'宏，你输入一组列（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
...

更新：

我找到了以下代码here：

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

在更大的宏中调用此代码的过程是什么？

Answer 1

这样的事情应该让你开始。如果您打算在不在第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

在Excel VBA中重新排序多个列

1 个答案: