VBA中的一维数组，二维数组排序问题

说明：

最近正在学习关于word的里面的排序问题，通过百度以及论坛里面的各种文章发现排序在很多编程中可以用Sort方法，但是VBA中没有。并且想要快速并且准确的进行排序难度比较大，最后就选择了其中的冒泡算法，把它整理写成函数，方便在word中进行排序，在此分享给大家

一、一维数组排序

1.运行效果

2.代码

Sub 调用示例()
    Dim brr
        brr = Array(4, 7, 1, 8, 2)
        brr = 冒泡排序升序排列_一维数组(brr)
End Sub
Function 冒泡排序升序排列_一维数组(brr)
    Dim arr, MinStr, s
    Dim i%, j%
    
    For i = 0 To UBound(brr)
        For j = i + 1 To UBound(brr)
            s = brr(j)
            If brr(i) > brr(j) Then
                brr(j) = brr(i)
                brr(i) = s
            End If
        Next j
    Next i
    冒泡排序升序排列_一维数组 = brr
End Function

二、二维数组排序

1、运行效果

2、代码

Sub 冒泡排序升序排列示例_二维数组_依据年龄()
    Dim data() As Variant
    data = Array(Array("张三", "男", 26), _
                 Array("李四", "女", 29), _
                 Array("王五", "男", 22), _
                 Array("赵六", "男", 55))
    Debug.Print "原二维数组："
    打印二维数组 data
    ' 调用排序函数对二维数组按年龄进行排序
    二维数组排序 data, 2
    
    ' 打印排序后的二维数组
    Debug.Print "排序后二维数组："
    打印二维数组 data
End Sub

Sub 二维数组排序(ByRef arr() As Variant, WeiDu As Integer)
    Dim numRows As Integer, i As Integer, j As Integer
    numRows = UBound(arr) - LBound(arr) + 1
    
    Dim temp As Variant
    
    For i = 0 To numRows - 1
        For j = 0 To numRows - 2
            If arr(j)(WeiDu) > arr(j + 1)(WeiDu) Then
                ' 交换位置
                temp = arr(j)
                arr(j) = arr(j + 1)
                arr(j + 1) = temp
            End If
        Next j
    Next i
End Sub

Sub 打印二维数组(arr() As Variant)
    Dim i As Integer, j As Integer
    For i = LBound(arr) To UBound(arr)
        For j = LBound(arr(i)) To UBound(arr(i))
            Debug.Print arr(i)(j); " ";
        Next j
        Debug.Print
    Next i
End Sub

3、方法二

Sub 二维数组排序2(ByRef arr() As Variant, WeiDu As Integer)
    Dim numRows As Integer, i As Integer, j As Integer, k As Integer
    Dim s As Single, s1 As Single
    numRows = UBound(arr) - LBound(arr) + 1
   
    Dim temp()
    ReDim temp(LBound(arr, 2) To UBound(arr, 2))
   
    For i = 0 To numRows - 1
        For j = 0 To numRows - 2
            s = arr(j, WeiDu)
            s1 = arr(j + 1, WeiDu)
            If s > s1 Then
                ' 交换位置
                For k = LBound(arr, 2) To UBound(arr, 2)
                    temp(k) = arr(j, k)
                    arr(j, k) = arr(j + 1, k)
                    arr(j + 1, k) = temp(k)
                Next
            End If
        Next j
    Next i
End Sub