Vba二維陣列根據陣列索引排序

我正在嘗試根據 Thickness tableData(i,5) 對 tableData 陣列進行排序。我在 excel 中試過沒有問題，但是當我在 Solidworks 中試過時我無法對它進行排序。我檢查了 excel 和 solidworks 中的回圈迭代有一些區別。這是我的代碼；

Dim temp0 As Double, temp1 As String, temp2 As Double, temp3 As String, temp4 As Double, temp5 As Double
    For i = 0 To UBound(tableData, 1) - 1
        For j = i   1 To UBound(tableData, 1)
            If tableData(i, 5) < tableData(j, 5) Then ' kal?nl?k
                temp0 = tableData(j, 0)
                temp1 = tableData(j, 1)
                temp2 = tableData(j, 2)
                temp3 = tableData(j, 3)
                temp4 = tableData(j, 4)
                temp5 = tableData(j, 5)
                tableData(j, 0) = tableData(i, 0)
                tableData(j, 1) = tableData(i, 1)
                tableData(j, 2) = tableData(i, 2)
                tableData(j, 3) = tableData(i, 3)
                tableData(j, 4) = tableData(i, 4)
                tableData(j, 5) = tableData(i, 5)
                tableData(i, 0) = temp0
                tableData(i, 1) = temp1
                tableData(i, 2) = temp2
                tableData(i, 3) = temp3
                tableData(i, 4) = temp4
                tableData(i, 5) = temp5
            End If
        Next j
    Next i

uj5u.com熱心網友回復：

我不在 SolidWorks 中作業...但是試試已知的 QuickSort 函式：

Extremely fast 2D array sorting:
'To be called as QuickSort2D arr, 3  to sort Ascending
'To be called as QuickSort2D arr, , , False to sort Descending
Private Sub QuickSort2D(SortArray, Col As Long, Optional l As Long = -1, Optional r As Long = -1, Optional bAscending As Boolean = True)
 Dim i As Long, j As Long, x, Y, k As Long

 If IsEmpty(SortArray) Then Exit Sub                        'the array is empty
 If InStr(TypeName(SortArray), "()") < 1 Then Exit Sub 'the array is not valid
 If l = -1 Then l = LBound(SortArray, 1)                    'to avoid an error when giving value to X
 If r = -1 Then r = UBound(SortArray, 1)                    'to avoid an error when giving value to X

 If l >= r Then Exit Sub                                    'no sorting needed, anymore

 i = l:  j = r
 x = SortArray((l   r) / 2, Col)                            'VBA automatically rounds (L   r)/2
                                                            'Choose an element of (aproximately) the middle of sorting column
 If bAscending Then
    While (i <= j)
        While (SortArray(i, Col) < x And i < r)
            i = i   1
        Wend
        While (x < SortArray(j, Col) And j > l)
            j = j - 1
        Wend
        If (i <= j) Then
            For k = LBound(SortArray, 2) To UBound(SortArray, 2)
                Y = SortArray(i, k)
                SortArray(i, k) = SortArray(j, k)
                SortArray(j, k) = Y
            Next k
        i = i   1: j = j - 1
        End If
    Wend
 Else
    While (i <= j)
        While (SortArray(i, Col) > x And i < r)
            i = i   1
        Wend
        While (x > SortArray(j, Col) And j > l)
            j = j - 1
        Wend
        If (i <= j) Then
            For k = LBound(SortArray, 2) To UBound(SortArray, 2)
                Y = SortArray(i, k)
                SortArray(i, k) = SortArray(j, k)
                SortArray(j, k) = Y
            Next k
            i = i   1: j = j - 1
        End If
    Wend
 End If
 If (l < j) Then Call QuickSort2D(SortArray, Col, l, j, bAscending)
 If (i < r) Then Call QuickSort2D(SortArray, Col, i, r, bAscending)
End Sub

嘗試根據下一個測驗 Sub 呼叫它（在 Excel 中）：

SubTestQuickSort2D()
   Dim arr, arr1
   
   arr = Range("D2:F7").Value2
   arr1 = arr
   Debug.Print arr1(3.4, 1): 'Stop
   QuickSort2D arr, 1
End Sub

真的是極快！

構建陣列并僅使用它的前兩個引數（第二個是要對其排序的列）和最后一個引數來呼叫該函式以按升序或降序排序。

作為標準的 VBA（陣列），我認為它也應該在 SolidWorks 中作業。

請在測驗后發送一些反饋。

標籤：VBA扎实的作品

上一篇：放在IF陳述句中時，RIGHT函式不起作用

下一篇：在另一列中列印if-then陳述句的輸出