|
|
Sub 排序二维()
arr = Range("A2:F" & Cells(Rows.Count, "A").End(xlUp).Row) '不要含标题
二维数组排序 arr, Array(6, 3, 4, 5), Array(2, 2, 2, 2) '为数字排序不要文本 依次按主次顺序排序 1为升序 其余为降序
Range("I2").Resize(UBound(arr), 6) = arr
End Sub
Function 二维数组排序(ByRef arr, ByVal toSortCols_arr, ByVal orders_ASC_or_DESC_arr)
If LBound(toSortCols_arr) = 0 Then ReDim Preserve toSortCols_arr(1 To UBound(toSortCols_arr) + 1)
If LBound(orders_ASC_or_DESC_arr) = 0 Then ReDim Preserve orders_ASC_or_DESC_arr(1 To UBound(orders_ASC_or_DESC_arr) + 1)
For i = UBound(toSortCols_arr) To LBound(toSortCols_arr) Step -1
sortArr arr, toSortCols_arr(i), orders_ASC_or_DESC_arr(i)
Next
End Function
Function sortArr(ByRef arr, ByVal sort_which_col_bgn_from1 As Integer, ByVal ASC_or_DESC)
l = LBound(arr)
u = UBound(arr)
If u = 0 Then Exit Function
sort_which_col_bgn_from1 = IIf(LBound(arr, 2) = 0, sort_which_col_bgn_from1 - 1, sort_which_col_bgn_from1)
Dim data(), result()
'读数组
If l = 0 Then
ReDim result(0 To u, 0 To 1): ReDim data(0 To u, 0 To 1)
For i = 0 To u
data(i, 0) = arr(i, sort_which_col_bgn_from1)
data(i, 1) = i
Next
ElseIf l = 1 Then
ReDim result(0 To u - 1, 0 To 1): ReDim data(0 To u - 1, 0 To 1)
For i = 0 To u - 1
data(i, 0) = arr(i + 1, sort_which_col_bgn_from1)
data(i, 1) = i + 1
Next
u = u - 1
Else
Exit Function
End If
'排序
数据段长 = 1
For 趟数 = 0 To Fix(Log(u) / Log(2)) Step 1
数据段长 = 数据段长 * 2
For 数据段首 = 0 To u Step 数据段长
If 数据段首 + 数据段长 - 1 > u Then
数据段尾 = u
Else
数据段尾 = 数据段首 + 数据段长 - 1
End If
If 数据段首 + 数据段长 / 2 - 1 > u Then
分割点 = u
Else
分割点 = 数据段首 + 数据段长 / 2 - 1
End If
Call Merge(data, result, 数据段首, 分割点, 数据段尾, ASC_or_DESC)
Next
For i = 0 To u
data(i, 0) = result(i, 0)
data(i, 1) = result(i, 1)
Next
Next
'输出
tempArr = arr
If l = 0 Then
For i = 0 To u
For j = LBound(arr, 2) To UBound(arr, 2)
arr(i, j) = tempArr(data(i, 1), j)
Next
Next
Else
For i = 0 To u
For j = LBound(arr, 2) To UBound(arr, 2)
arr(i + 1, j) = tempArr(data(i, 1), j)
Next
Next
End If
End Function
Function Merge(data(), result(), ByVal 数据段首, ByVal 分割点, ByVal 数据段尾, ByVal ASC_or_DESC)
i = 分割点 + 1: j = 数据段首
Do While 数据段首 <= 分割点 And i <= 数据段尾
If ASC_or_DESC = 1 Then
If data(数据段首, 0) <= data(i, 0) Then
result(j, 0) = data(数据段首, 0)
result(j, 1) = data(数据段首, 1)
数据段首 = 数据段首 + 1
Else
result(j, 0) = data(i, 0)
result(j, 1) = data(i, 1)
i = i + 1
End If
Else
If data(数据段首, 0) >= data(i, 0) Then
result(j, 0) = data(数据段首, 0)
result(j, 1) = data(数据段首, 1)
数据段首 = 数据段首 + 1
Else
result(j, 0) = data(i, 0)
result(j, 1) = data(i, 1)
i = i + 1
End If
End If
j = j + 1
Loop
For rest = 数据段首 To 分割点
result(j, 0) = data(rest, 0)
result(j, 1) = data(rest, 1)
j = j + 1
Next
For rest = i To 数据段尾
result(j, 0) = data(rest, 0)
result(j, 1) = data(rest, 1)
j = j + 1
Next
End Function |
|
楼主: 伶俐的毛豆
沪公网安备 31011702000001号 沪ICP备11019229号-2
楼主
发表于 2024-1-18 22:01
