对声明为一个暗淡数组并插入值作为 array() 的两个暗淡数组进行排序

Question

我在死胡同里，我什至无法弄清楚 google :(

假设我有这个例子（请不要评论说创建这样一个数组可能是更好的方法，这是故意的）：

Dim someArray() As Variant: ReDim someArray(0 To 0)
ReDim Preserve someArray(0 To UBound(someArray) + 1): someArray(UBound(someArray)) = Array(6, CStr("text1"), CLng(5), CDbl(100))
ReDim Preserve someArray(0 To UBound(someArray) + 1): someArray(UBound(someArray)) = Array(6, CStr("text2"), CLng(3), CDbl(101))
ReDim Preserve someArray(0 To UBound(someArray) + 1): someArray(UBound(someArray)) = Array(6, CStr("text4"), CLng(2), CDbl(102))
ReDim Preserve someArray(0 To UBound(someArray) + 1): someArray(UBound(someArray)) = Array(6, CStr("text3"), CLng(1), CDbl(100))

我需要的是根据我传递的两个列计算出在 someArray() from (1 to UBound(someArray)) 中按两列排序的函数作为参数：

所以 eather 首先按第二列 (1) 排序，即 CStr，如果记录相同则按第三列 (2) 排序
或者我将哪两列设置为函数中的参数进行排序

不幸的是我在这里迷路了...唯一真正糟糕的选择是将数据插入新的 sheet，让 worksheet 函数对其进行相应的排序，然后重新插入数组，这是我绝对不想做的事情:(

谢谢你的想法...

Answer 1

我把你的问题当作一个挑战，并找到了一种按照你需要的方式对锯齿状数组进行伪排序的方法。我的意思是，它将根据第二个元素或第三个元素重新排列锯齿状数组数组，如果第二个元素顺序正确：

Sub SortArraysInJaggedArray()
 Dim someArray() As Variant: ReDim someArray(0)
 someArray(0) = Array(6, CStr("text1"), CLng(5), CDbl(100)) 'to load the first array element. Otherwise, it would be empty
 ReDim Preserve someArray(UBound(someArray) + 1): someArray(UBound(someArray)) = Array(6, CStr("text2"), CLng(3), CDbl(101))
 ReDim Preserve someArray(UBound(someArray) + 1): someArray(UBound(someArray)) = Array(6, CStr("text4"), CLng(2), CDbl(102))
 ReDim Preserve someArray(UBound(someArray) + 1): someArray(UBound(someArray)) = Array(6, CStr("text3"), CLng(1), CDbl(100))
 
 Dim arrS
 arrS = sortJaggArr(someArray, 1)
 
 'visually test the result:
 Debug.Print someArray(2)(1), arrS(2)(1): Stop
 Debug.Print someArray(3)(1), arrS(3)(1): Stop
End Sub

Function sortJaggArr(arrJ As Variant, sortCol As Long) As Variant
    Dim i As Long, j As Long, arrInit, arrSort, arrComp, arrMtch
    
ReCheck:
 ReDim arrInit(UBound(arrJ))
 For i = 0 To UBound(arrJ)
    arrInit(i) = arrJ(i)(sortCol)
 Next
 arrSort = arrInit: BubbleSort arrSort
 'Debug.Print Join(arrInit, "|"): Debug.Print Join(arrSort, "|")
 'build a comparison array a continuous range of numbers:
 arrComp = Evaluate("TRANSPOSE(ROW(1:" & UBound(arrInit) + 1 & "))")
 'obtain an array of each element matching:
 arrMtch = Application.match(arrInit, arrSort, 0) 'returns an array of matches
  'Debug.Print Join(arrMtch, "|"): Stop
 'check if arrSort is different than arrInit:
 If Join(arrComp, "") = Join(arrMtch, "") Then 'if they match, try the next column
    sortCol = sortCol + 1
    If sortCol <= 2 Then GoTo ReCheck
 End If
 If sortCol = UBound(arrJ) Then
    MsgBox "The array is already sorted..."
    sortJaggArr = arrJ: Exit Function
 End If
 'Debug.Print Join(arrComp, "|"): Debug.Print Join(arrMtch, "|"): Stop
 'make the sorting of arrays
 Dim newArr: ReDim newArr(UBound(arrJ))
 For i = 0 To UBound(arrJ)
    If arrComp(i + 1) = arrMtch(i + 1) Then
        newArr(i) = arrJ(i)
    Else
        newArr(i) = arrJ(arrMtch(i + 1) - 1)
    End If
 Next i
 sortJaggArr = newArr
End Function

Private Sub BubbleSort(arr)
    Dim i As Long, j As Long, temp
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If arr(i) > arr(j) Then
                temp = arr(i): arr(i) = arr(j)
                arr(j) = temp
            End If
        Next j
    Next i
End Sub

我在函数中加入了一些注释行（出于教学目的），以提供查看特定（连接）数组的 return 的可能性...

请在测试后发送一些反馈。

如果有什么地方不够清楚，请不要犹豫，要求澄清...

对声明为一个暗淡数组并插入值作为 array() 的两个暗淡数组进行排序

sort two dim array which is declared as one dim array and inserted values as array()

arrays

vba

sorting

multidimensional-array

vba6