求一排序函数
有一列表内数据如下
1.JPG
4.JPG
22.JPG
3.JPG
8.JPG
11.JPG
16.JPG
2.JPG
。。。

如何将这类的数据进行排序呢。
[解决办法]
本帖最后由 bcrun 于 2013-07-23 16:10:14 编辑

Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long 
' 生成数据到一个文本文件
Private Sub Command1_Click()
    Dim test As String
    Dim i As Long
Dim savetime As Long
savetime = GetTickCount
    Open App.Path & "\" & Text1.Text For Output As #1
    For i = 1 To 100000
        test = String(8 - Len(Hex(i)), "0") & Hex(i)
        Print #1, test
    Next i
    Close #1
MsgBox "耗时：" & GetTickCount - savetime & " 毫秒"
End Sub
' 读取文本文件的每一行数据对其进行排序输出
Private Sub Command2_Click()
    Dim ReadArray() As String
    Dim lngArraySize As Long
    Dim strTmp As String
    Dim fs As Integer
    Dim row As Long
    Dim i As Long
    Dim j As Long
    Dim index As Long
    Dim IsCompositor As Boolean
Dim savetime As Long
savetime = GetTickCount
    '========== 把文本文件以行为单位读入字符串数组 ==========
    row = 0
    ReDim ReadArray(row)
    fs = FreeFile
    Open App.Path & "\" & Text1.Text For Input As #fs
    Do While Not EOF(fs)
    Line Input #fs, strTmp
    ReadArray(row) = strTmp
    row = row + 1
    ReDim Preserve ReadArray(row)
    Loop
    Close #fs
    lngArraySize = row - 1
    ReDim Preserve ReadArray(lngArraySize)
     
    '========== 对数组进行排序 ==========
    '快速法
    Call compositor_quick(ReadArray, 0, lngArraySize)
     
    '========== 将排序好的数组输出 ==========
    For i = 0 To lngArraySize
        List1.AddItem ReadArray(i)
    Next i
Dim overtime As Long
overtime = GetTickCount
MsgBox "耗时：" & GetTickCount - savetime & " 毫秒"
End Sub
' 数组排序函数
Private Sub compositor_quick(strArray() As String, i As Long, j As Long)
    Dim m As Long, _
        n As Long, _
        temp As String, _
        strTmp As String
    m = i
    n = j
    strTmp = strArray((m + n) / 2)
    Do
        ' 从左到右找比k大的元素
        Do While (strArray(m) < strTmp And m < j)
            m = m + 1
        Loop
        ' 从右到左找比k小的元素
        Do While (strArray(n) > strTmp And n > i)
            n = n - 1
        Loop
        If m <= n Then 
 
            ' 若找到且满足条件，则交换
            temp = strArray(m)
            strArray(m) = strArray(n)
            strArray(n) = temp
            m = m + 1
            n = n - 1
        End If
    Loop While m <= n
    If m < j Then compositor_quick strArray, m, j '/*运用递归*/
    If n > i Then compositor_quick strArray, i, n
End Sub

[解决办法]

无论什么规则，最后只不过是在过程里改点细节的问题，如数组类型为整形、日期类型，对比时的变量或大于小于条件改变一下而已，甚至是多条件分级别排序（类似SQL的排序需求），都可以这么弄出来，如文件的创建日期、文件类型、文件名等等综合条件的排序，无非就是弄个结构体，在循环时多设置几个判断条件就可以实现这种综合条件排序了，这种方法可以说适用于各种需求的排序处理，其使用的问题在于使用者是否理解这种排序方法，并能够融会贯通这种理念才好对其进行修改，如果还有问题就是实用的算法是否够快的问题，但经过测试，效率基本上还是能接受的。当然，这种过程也可以进一步封装，使得使用者可以很简单的对多条件数据进行排序，比如使用二维数组，然后加个优先级别参数，如：

Redim Files(1,3)
Files(0,0) = "4.jpg"
Files(0,1) = #2013-7-21 00:58:00#
Files(0,2) = "jpg"
Files(0,3) = 3000000
Files(1,0) = "2.jpg"
Files(1,1) = #2013-7-21 00:58:00#
Files(1,2) = "jpg"
Files(1,3) = 132701
' 调用排序过程
Call CompositorArray(Files,"2:asc,1:desc,0:asc,3:asc")
...
' 定义排序函数
Sub CompositorArray(ByRef arr() as Variant,ByVal PRI As String)
...
End Sub

这样一来这种过程的可重用性就会很强，实用性也很高，而且效率可以自己掌控（看自己的算法啦）。更为重要的是这是一种技术，而不是用某种工具，这种技术可以跨语言、跨平台的使用，我在做以前的一个单片机项目中就用过这种技术，主要处理任务队列，可以说解决了很大的问题，只不过单片机上的过程就没有 CompositorArray 这种结构复杂，是根据具体需求改出来的排序过程。
[解决办法]

Private Sub Command6_Click()
    Dim DriverObject As Object, _
        FileObject As Object, _
        fObject As Object, _
        NowPath As String, _
        FileArray() As String, _
        FileCount As Long, _
        TempName As String, _
        TempTime As Date, _
        i As Long, _
        j As Long, _
        is_compositor As Boolean
    List1.Clear
    NowPath = App.Path
    ' 用 fso 查询路径得到指定路径下的文件
    Set DriverObject = CreateObject("Scripting.FileSystemObject")
    If DriverObject.FolderExists(NowPath) Then
        Set FileObject = DriverObject.GetFolder(NowPath).Files
        FileCount = FileObject.count
        ReDim FileArray(FileCount - 1, 1)
        i = 0
        For Each fObject In FileObject
            FileArray(i, 0) = fObject.Name
            FileArray(i, 1) = fObject.DateLastModified
            i = i + 1
        Next
        Set FileObject = Nothing
    End If
    If FileCount >= 1 Then
        ' 简单的冒泡法排序,效率很低，不过作为数据不多的文件处理够用了，最主要的是容易理解
        For i = 0 To FileCount - 1
            For j = 0 To FileCount - 1
                If Len(FileArray(i, 0)) < Len(FileArray(j, 0)) Then
                    is_compositor = True
                Else
                    If FileArray(i, 0) < FileArray(j, 0) Then
                        is_compositor = True 
 
                    Else
                        is_compositor = False
                    End If
                End If

                If is_compositor Then
                    TempName = FileArray(j, 0)
                    TempTime = FileArray(j, 1)
                    FileArray(j, 0) = FileArray(i, 0)
                    FileArray(j, 1) = FileArray(i, 1)
                    FileArray(i, 0) = TempName
                    FileArray(i, 1) = TempTime
                End If
            Next
        Next
        For i = 0 To FileCount - 1
            List1.AddItem FileArray(i, 0)
        Next
    End If
End Sub

[解决办法]
类似楼主这样的问题，我在2006年给我的好友做的，用VBA处理Excel报表时就遇到了。
我就是根据需求，把它分成了3个类别，分别排序后输出。
但排序依据就复杂得多了，先根据分出的“类别”，再按“3到5个列”中的数据值，来决定哪个排在前、哪个排在后，这样才形成了一个规范、清晰的报表。
说实在的，她们之前用Excel的数据透视表弄出来的报表，我看着都烦。那个内容之乱哦……没话说
　　单说那个包含数值的字符串，楼主的仅是“一段”，我那个要处理的是分成３段的，并且第２、第３段分别再可以分为：1个数值，和用/隔开的两个数值 这两种（数值也是有整数和带小数点的数，当然这不算问题）。

正如SupermanKing说的那样，只要知道如何排序，再复杂的排序也不是问题。

[解决办法]
说个思路，
1、建立数组存入文件名
2、求最长文件名的长度N
3、用Format将文件名前边补0，然后排序
4、去除前边添加的0