Reordering Multiple Columns in Excel VBA

问题

Is there a way to create a 'permutation' macro where you input a set of columns (A....Z) and it gives a chosen alternate ordering (e.g. (B,A,E,D,C,...,Z))? I imagine this is something that has been done before but it is surprisingly hard to find any precedent.

Initially I was thinking of copying / pasting using Range().Copy / .Paste in a tedious way or similarly with Columns, that is:

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
...

UPDATE:

I did find the following code 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

What is the process for calling this code in a larger macro?

回答1:

Something like this should get you started. It will need some revision that I don't have time for, if you intend to use it on tables that do not begin in Row 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

来源：https://stackoverflow.com/questions/23702934/reordering-multiple-columns-in-excel-vba

标签

excel

vba