Question

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

以下代码：

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

Answer 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

按名称重新排序列标题

1 个答案: