# VBA 二维数组冒泡排序实例

VBA程序 专栏收录该内容
2 篇文章 0 订阅

Private Sub test()
Dim arr()
Sheets("sheet1").Select
Row = Sheets("sheet1").UsedRange.Rows.count
col = Sheets("sheet1").UsedRange.Columns.count
ReDim arr(1 To Row, 1 To 6)
arr = Range("a1:F" & Row)

arr = bubblesort(arr, 0, 2, 2)

Range("j1:O" & Row) = arr

End Sub

Public Function bubblesort(ByRef snarray(), sort As Boolean, column As Integer, title As Integer)
'sort 为升降序标记，column为需排序列，title为标题行数（不参与排序的行数）
Dim iouter As Long
Dim iinner As Long
Dim ilbound As Long
Dim iubound As Long
Dim issort As Boolean
Dim count As Integer
Dim temp As Integer
Dim itemp
ReDim itemp(1, LBound(snarray, 2) To UBound(snarray, 2))
Dim SORTED As Integer
lastindex = 0
tlbound = LBound(snarray, 2)
tubound = UBound(snarray, 2)
ilbound = LBound(snarray) + title
iubound = UBound(snarray)
SORTED = iubound - iouter - 1
Select Case sort
Case 0 '参数为0时升序
For iouter = ilbound To iubound - 1
issort = True

For iinner = ilbound To SORTED 'iubound - iouter - 1
If snarray(iinner, column) > snarray(iinner + 1, column) Then

For temp = tlbound To tubound '数组整行数据交换
itemp(1, temp) = snarray(iinner, temp)
snarray(iinner, temp) = snarray(iinner + 1, temp)
snarray(iinner + 1, temp) = itemp(1, temp)
Next temp

issort = False  '标记是否有排序动作
count = count + 1   '记录排序次数，可删除
lastindex = iinner  '记录最后排序位置
End If

Next iinner

If issort = True Then Exit For   '如果没有排序动作则为全部排序完成，跳出循环，排序结束
SORTED = lastindex   '接下来的循环只到最后排序位置

Next iouter

Case 1 '参数为1时降序
For iouter = ilbound To iubound - 1
issort = True

For iinner = ilbound To SORTED 'iubound - iouter - 1
If snarray(iinner, column) < snarray(iinner + 1, column) Then

For temp = tlbound To tubound '数组整行数据交换
itemp(1, temp) = snarray(iinner, temp)
snarray(iinner, temp) = snarray(iinner + 1, temp)
snarray(iinner + 1, temp) = itemp(1, temp)
Next temp

issort = False  '标记是否有排序动作
count = count + 1   '记录排序次数，可删除
lastindex = iinner  '记录最后排序位置
End If

Next iinner

If issort = True Then Exit For   '如果没有排序动作则为全部排序完成，跳出循环，排序结束
SORTED = lastindex   '接下来的循环只到最后排序位置

Next iouter

End Select

Sheets(1).Range("I1") = count
bubblesort = snarray
End Function

• 2
点赞
• 1
评论
• 4
收藏
• 打赏
• 扫一扫，分享海报

06-11
07-25
10-16 1万+
03-15 1万+
07-02 2424
04-05 1325
07-15 1万+
03-08 2333

¥2 ¥4 ¥6 ¥10 ¥20

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、C币套餐、付费专栏及课程。