在Excel VBA中重新排序多列 [英] Reordering Multiple Columns in Excel VBA

问题描述

有没有一种创建置换"宏的方法，您可以在其中输入一组列(A .... Z)并给出选定的替代顺序(例如(B，A，E，D，C ,...，Z))?我想这是以前做过的事情，但令人惊讶的是很难找到任何先例.

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.

最初，我是在考虑使用 Range().Copy / .Paste 进行复制/粘贴，这很乏味，或者与 Columns 类似，即:

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

更新:

我确实找到了以下代码

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

这篇关于在Excel VBA中重新排序多列的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！