求一个排序的VBA

剑指E

1. Sub BubbleSortRows()
   
2.     Dim c As Range, ar(), i&, j&, k&, temp, h&, w&, w0&
   
3.     With Sheets("原数据")
   
4.         Set c = Intersect(.Range("A1").CurrentRegion, .Range("2:9999"))
   
5.         Sheets("排列后").[1:1] = .[1:1].Value2
   
6.     ' 将数据读取到数组中
   
7.     ar = c.Value
   
8.     ' 获取行数和列数
   
9.     h = UBound(ar, 1)
   
10.     w0 = UBound(ar, 2)
    
11.     ' 对每一行进行冒泡排序
    
12.     For i = 1 To h
    
13.     ' 获取子行列数
    
14.         For j = w0 To 1 Step -1
    
15.             If ar(i, j) <> "" Then w = j: Exit For
    
16.         Next
    
17.         For j = 1 To w - 1
    
18.             For k = j + 1 To w
    
19.                 If ar(i, j) > ar(i, k) Then
    
20.                     ' 交换数据
    
21.                     temp = ar(i, j)
    
22.                     ar(i, j) = ar(i, k)
    
23.                     ar(i, k) = temp
    
24.                 End If
    
25.             Next k
    
26.         Next j
    
27.     Next i
    
28.     End With
    
29.     ' 将排序后的数据写回到Excel中
    
30.     Sheets("排列后").[a2].Resize(h, w) = ar
    
31. End Sub
    

复制代码

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar, br, i&, j&, n&
   
    Application.ScreenUpdating = False
   
    ar = Sheets("原数据").[A1].CurrentRegion.Value
    For i = 1 To UBound(ar)
        br = Application.Index(ar, i)
        ShellSort1D br, 1, UBound(br)
        n = 0
        For j = 1 To UBound(br)
            ar(i, j) = ""
            If Len(br(j)) Then n = n + 1: ar(i, n) = br(j)
        Next j
    Next i
        
    Cells.Clear
    [A1].Resize(UBound(ar), UBound(ar, 2)) = ar
    Application.ScreenUpdating = True
    Beep
End Sub
Function ShellSort1D(ByRef ar, ByVal iFirst&, _
    ByVal iLast&, Optional isOrder As Boolean = True)

    Dim iRowSize&, vTemp, interval&, i&, j&, k&

    ReDim vTemp(iFirst To iLast)
    iRowSize = iLast - iFirst + 1
    interval = 1

    If iRowSize > 13 Then
        Do While interval < iRowSize
            interval = interval * 3 + 1
        Loop
        interval = interval \ 9
    End If

    Do While interval
        For i = iFirst + interval To iLast
            vTemp = ar(i)
            If isOrder Then
                For k = i - interval To iFirst Step -interval
                If ar(k) <= vTemp Then Exit For
                ar(k + interval) = ar(k)
                Next k
            Else
                For k = i - interval To iFirst Step -interval
                    If ar(k) > vTemp Then Exit For
                    ar(k + interval) = ar(k)
                Next k
            End If
            ar(k + interval) = vTemp
        Next i
        interval = interval \ 3
    Loop

End Function

gwjkkkkk

参与一下。。。

今铭昔

LIUZHU

今铭昔 发表于 2024-6-20 06:49

这种排序对JS来说小Case了