Excel中按列的首行字母顺序,重新排列(VBA脚本)

排序前

要求对4列数据按照第一行abcd的顺序排列

VB脚本如下:

要使用这个脚本,请按照以下步骤操作:

  1. 打开Excel,然后按下 Alt + F11 打开VBA编辑器。
  2. 在VBA编辑器中,选择"插入" > "模块",在打开的模块窗口中粘贴上面的代码。
  3. 选择你想要排序的单元格区域。
  4. 按下 F5 运行宏或关闭VBA编辑器,在Excel中通过"开发工具" > "宏"来选择并运行这个宏。
vbscript 复制代码
Sub SortColumnsByFirstRow()
    Dim rng As Range
    Dim data() As Variant
    Dim colOrder() As Variant
    Dim i As Integer, j As Integer
    Dim temp As Integer

    ' 检查选择区域
    If Selection.Areas.Count <> 1 Then
        MsgBox "请选择一个单一的单元格区域进行排序。", vbExclamation
        Exit Sub
    End If
    
    ' 获取选择区域
    Set rng = Selection
    If rng.Cells(1, 1).MergeCells Then
        MsgBox "选定区域内含有合并的单元格,请先解除合并。", vbExclamation
        Exit Sub
    End If
    
    ' 将选择区域的数据写入数组
    data = rng.Value
    
    ' 获取列的数量
    Dim colCount As Integer
    colCount = UBound(data, 2)
    
    ' 创建列顺序数组
    ReDim colOrder(1 To colCount)
    ReDim data_1(1 To colCount)
    For i = 1 To colCount
        colOrder(i) = i
        data_1(i) = data(1, i)
    Next i
    
    ' 使用冒泡排序算法根据首行数据对列进行排序
    For i = 1 To colCount - 1
        For j = 1 To colCount - i
            If data_1(j) > data_1(j + 1) Then
                ' 交换列的顺序
                temp = colOrder(j)
                colOrder(j) = colOrder(j + 1)
                colOrder(j + 1) = temp
                
                Dim temp1 As Variant
                temp1 = data_1(j)
                data_1(j) = data_1(j + 1)
                data_1(j + 1) = temp1
            End If
        Next j
        'MsgBox "i=" & colCount - i & " " & colOrder(colCount - i) & " " & data(1, colCount - i)
    Next i
    
    'For i = 1 To colCount
    '    MsgBox "i=" & i & " " & colOrder(i) & " " & data(1, i)
    'Next i
    
    
    ' 根据排序后的列顺序重新写入数据
    Dim sortedData() As Variant
    ReDim sortedData(1 To UBound(data, 1), 1 To colCount)
    
    For i = 1 To colCount
        For j = 1 To UBound(data, 1)
            sortedData(j, i) = data(j, colOrder(i))
            'MsgBox j & i & sortedData(j, i)
        Next j
    Next i
    
    ' 将排序后的数据重新写回Excel范围
    rng.Value = sortedData

    ' 调整列宽
    For i = 1 To colCount
        rng.Columns(i).AutoFit
    Next i

    MsgBox "所选单元格区域已按首行字母顺序排序完成。", vbInformation
End Sub