按名称重新排序列标题答案

【问题标题】：Reordering column headers by name按名称重新排序列标题
【发布时间】：2018-01-11 18:05:22
【问题描述】：

我正在尝试按名称重新排序列标题，但我遇到了几个问题。首先是某些列标题是相同的（它们从导出中是这样的）。第二个是我正在使用的当前代码似乎没有在第一次或某些时候正确排列所有标题。三是运行比较慢。

代码如下：

Dim arrColOrder As Variant, i As Integer
Dim Found As Range, counter As Integer


arrColOrder = Array("Reporting Status", "CloseRecord", "Tracking Number", "Close Record", "Tracking Number", "Close Record: Only")

counter = 1

Application.ScreenUpdating = False

For i = LBound(arrColOrder) To UBound(arrColOrder)

    Set Found = Rows("1:1").Find(arrColOrder(i), LookIn:=xlValues, LookAt:=xlWhole, _
                      SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=True)

    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 i

Application.ScreenUpdating = True

End Sub

【问题讨论】：

你为什么不直接排序？
嘿@SJR，这是个好问题。我不知道可以根据数组进行排序
哈，其实我以为你在排序一个范围。搜索冒泡排序，网上有很多例子。例如也许这有助于stackoverflow.com/questions/15509255/…
@SJR 乍一看，这似乎不是我想要的：我有一个非常具体的顺序，我想要列，而不是字母顺序。如果有帮助，上面的数组只是整个数组的一小部分。有 50 多列可供订购。
好吧，我可能有点草率了。仔细观察后，看起来好像您正在按照数组中定义的顺序对范围进行排序。是对的吗？如果是这样，您可以使用匹配公式添加另一行，然后对该行进行排序？

标签： vba excel

【解决方案1】：

这个怎么样？

Dim Rng As Range
Dim arrColOrder As Variant, i As Integer, lc As Integer
Dim Found As Range

arrColOrder = Array("Reporting Status", "CloseRecord", "Tracking Number", "Close Record", "Tracking Number", "Close Record: Only")


Application.ScreenUpdating = False

lc = Cells(1, Columns.Count).End(xlUp).Column
Set Rng = Range(Cells(1, 1), Cells(1, lc))

For i = LBound(arrColOrder) To UBound(arrColOrder)

    Set Found = Rng.Find(arrColOrder(i), LookIn:=xlValues, LookAt:=xlWhole, _
                      SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=True)

    If Not Found Is Nothing Then
        If Found.Column = i + 1 Then GoTo Skip
            If Found.Column <> i + 1 Then
                Found.EntireColumn.Cut
                Columns(i + 1).Insert Shift:=xlToRight
                Application.CutCopyMode = False
                Set Rng = Range(Cells(1, Found.Column + 1), Cells(1, lc))
            End If
    End If
Skip:
Next i

Application.ScreenUpdating = True

【讨论】：