|
- Sub main()
- Dim arr, Callback$
- arr = [a2:c100] '假设数据区域,按照第二列的"文本"进行降序!
- Callback = "function(x,y){return y[1].localeCompare(x[1])}"
- Call msort(arr, Callback, 2)
- [a2:c100] = arr
- End Sub
- Sub msort(ByRef a, ByVal q As String, ByVal k As Integer)
- ' a为源数组;q为回调函数,k为1是一维数组为2是二维数组
- Dim js As Object, i&
- Set js = CreateObject("MSScriptControl.ScriptControl")
- js.Language = "JavaScript"
- If k = 2 Then
- Dim l1&, l2&, u1&, u2&, s$, sr$, j&
- l1 = LBound(a): l2 = LBound(a, 2): u1 = UBound(a): u2 = UBound(a, 2)
- For i = l1 To u1
- For j = l2 To u2
- If j = l2 Then s = "'" & a(i, j) & "'" Else: s = s & "," & "'" & a(i, j) & "'"
- Next
- sr = sr & "," & "[" & s & "]": s = Empty
- Next
- sr = "[" & Mid(sr, 2) & "]"
- js.AddCode "a=" & sr & ";a.sort(" & q & ")"
- For i = l1 To u1
- For j = l2 To u2
- a(i, j) = js.eval("a[" & i - l1 & "][" & j - l2 & "]")
- Next
- Next
- ElseIf k = 1 Then
- Dim l&, u&, s1$
- l = LBound(a): u = UBound(a)
- For i = l To u
- If i = l Then s1 = "'" & a(i) & "'" Else: s1 = s1 & "," & "'" & a(i) & "'"
- Next
- s1 = "[" & s1 & "]"
- js.AddCode "a=" & s1 & ";a.sort(" & q & ")"
- For i = l To u
- a(i) = js.eval("a[" & i - l & "]")
- Next
- End If
- End Sub
复制代码
|
评分
-
1
查看全部评分
-
|