数组内重新排序

simic1989

请问有什么方法可以在数组内重新排序，类似range.sort的通用方法。比如附件中，先放入数组中，再按条件，日期时间或者数字大小重新排序

魂断蓝桥

Sub A()
Dim rs, arr, i%
Set rs = CreateObject("adodb.recordset")
arr = [a1].CurrentRegion
   With rs
        .Fields.Append "日期", 7
        .Fields.Append "数值", 6
        .Open
    End With
For i = 2 To UBound(arr)
            rs.AddNew Array(0, 1), _
            Array(arr(i, 1), arr(i, 2))
Next
       rs.Sort = "日期 desc"
    [d:z] = ""
   Range("d1").CopyFromRecordset rs
rs.Close
Set rs = Nothing
End Sub

不知道为什么

楼主的需求，也正是我前段时间学习数组和字典时的一个困惑。可惜还没掌握二楼蓝桥老师的知识点。后来通过很笨的办法，数组之间的转换达到目的。给你附件增加了几列做测试。如图

wj2368

再简单的就是重新定入工作表排序后再写入

不知道为什么

wj2368 发表于 2018-9-10 12:56
再简单的就是重新定入工作表排序后再写入

呵呵，是的，可是楼主限定不让用工作表排序。

不知道为什么

参考

一把小刀闯天下

'可以指定多列，并对指定的多列分别设定升、降序，，，

'数据量大可以改用快排

Option Explicit

Sub test()
  Dim arr, i, j, k, order
  arr = Range("a1:b" & Cells(Rows.Count, "a").End(xlUp).Row + 1)
  order = Array(1, True, 2, False) '指定列,A升序、B降序
  Call dsort(arr, 1, UBound(arr, 1) - 1, order(0), order(1)) '对主列先排序
  For i = 0 To UBound(order) - 2 Step 2
    For j = 1 To UBound(arr, 1) - 1
      For k = j To UBound(arr, 1) - 1
        If arr(k, order(i)) <> arr(k + 1, order(i)) Then
          If k > j Then Call dsort(arr, j, k, order(i + 2), order(i + 3))
          j = k: Exit For
        End If
  Next k, j, i
  [d1].Resize(UBound(arr, 1) - 1, UBound(arr, 2)) = arr
End Sub

Function dsort(arr, first, last, key, order)
  Dim i, j, k, t
  For i = first To last - 1
    For j = i + 1 To last
      If arr(i, key) < arr(j, key) Xor order Then
        For k = 1 To UBound(arr, 2)
          t = arr(i, k): arr(i, k) = arr(j, k): arr(j, k) = t
        Next
      End If
  Next j, i
End Function

duquancai

按照第二列“数字”倒序，请测试！！！

1. Sub main()
   
2.     Dim arr
   
3.     arr = [a1:b11]: [d:e].Clear: [d:d].NumberFormat = "yyyy/m/d"
   
4.     Call mySort(arr, "function q(x,y){return y[1]-x[1]};", 1, 1, 11, 2)
   
5.     [d1].Resize(11, 2) = arr
   
6. End Sub
   
7. Sub mySort(ByRef a, ByVal p$, ByVal l1&, ByVal l2&, ByVal u1&, ByVal u2&)
   
8.     Dim js As Object, i&, j&, s$, sr$
   
9.     Set js = CreateObject("MSScriptControl.ScriptControl")
   
10.     js.Language = "JavaScript"
    
11.     For i = l1 To u1
    
12.         For j = l2 To u2
    
13.             s = s & "," & "'" & a(i, j) & "'"
    
14.         Next
    
15.         sr = sr & "," & "[" & Mid(s, 2) & "]": s = Empty
    
16.     Next
    
17.     js.AddCode "a=" & "[" & Mid(sr, 2) & "]" & ";" & p & "a.sort(q);"
    
18.     For i = l1 To u1
    
19.         For j = l2 To u2
    
20.             a(i, j) = js.eval("a[" & i - l1 & "][" & j - l2 & "]")
    
21.         Next
    
22.     Next
    
23. End Sub

复制代码

simic1989

不知道为什么 发表于 2018-9-10 13:10
呵呵，是的，可是楼主限定不让用工作表排序。

其实我主要想看看有没有想.sort的方法简单易懂，如果很麻烦的话，我直接直接新建表排序再写入了，毕竟不是专业程序员，学习精力有限，实用为主。

魂断蓝桥

simic1989 发表于 2018-9-10 14:17
其实我主要想看看有没有想.sort的方法简单易懂，如果很麻烦的话，我直接直接新建表排序再写入了，毕竟不 ...

数据量不大的话，用ado就可以了，代码简单也好理解。