0

我正在通过目录运行 VBA 脚本，但我需要像在 Windows 资源管理器中对文件进行排序一样浏览文件。例如，我有一个这样的目录：

32 Read.log
64 Write.log
256 Read.log
512 Write.log
1024 Write.log
4 Read.log

当我使用 VBA 对其进行排序时，它只会查看第一个字符来对其进行排序：

1024 Write.log
256 Read.log
32 Read.log
4 Read.log
512 Write.log
64 Write.log

在我浏览目录之前如何从最小到最大排序的任何想法？

4

3 回答 3

0

将数据导入 Excel 后，解析数据，使大小位于 A 列，名称位于 B 列。然后确保（或转换）A 列中的数据为值而不是文本。然后按 A 升序对 A 列和 B 列进行排序。

于 2013-10-10T15:04:59.760 回答
0

将目录读入字典对象，CreateObject("Scripting.Dictionary")并编写一个函数，以您想要的方式对字典进行排序。

可以在这个问题上找到一个例子： 排序字典

编辑：如果您已经将它放在数组中，则可以调整代码以对数组进行排序

编辑：使用字典的简单示例：

Dim vArray As Variant
Dim vDict As Object
Dim i As Variant

vArray = Array("F1", "F2", "F3")
Set vDict = CreateObject("Scripting.Dictionary")
For i = LBound(vArray) To UBound(vArray)
    vDict.Add i, vArray(i)
Next
For Each i In vDict
    MsgBox "Key: " & i & ", Value: " & vDict(i)
Next
于 2013-10-10T15:00:34.817 回答
0

我实际上为它构建了一个算法的麻烦：

Dim a As Variant
Dim c As String
Dim d As String
Dim x As Long
Dim y As Long
Dim s As Boolean
Dim p As Long
Dim q As Long
Dim e As Long
Dim n1 As String
Dim n2 As String

'Create a dummy array to test
a = Array("1024 Write.log", "256 Read.log", "32 Read.log", "4 Read.log", "512 Write.log", "64 Write.log")

'Loop through the array and look for values that need to change position
For x = LBound(a) To UBound(a) - 1
    For y = x + 1 To UBound(a)

        'Check if the values at x and y must be swapped
        s = False

        'Loop through each character in both strings to do a compare
        If Len(a(x)) > Len(a(y)) Then e = Len(a(x)) Else e = Len(a(y))
        For p = 1 To e
            If Len(a(x)) < p Then
                'y is longer, so it should come last
                Exit For
            ElseIf Len(a(y)) < p Then
                'y is shorter, so it should come first
                s = True
                Exit For
            ElseIf InStr("0123456789", Mid(a(x), p, 1)) = 0 Or InStr("0123456789", Mid(a(y), p, 1)) = 0 Then
                'The char at p in x or y is not a number, so do a text compare
                If Mid(a(x), p, 1) < Mid(a(y), p, 1) Then
                    Exit For
                ElseIf Mid(a(x), p, 1) > Mid(a(y), p, 1) Then
                    s = True
                    Exit For
                End If
            Else
                'The char at p for both x and y are numbers, so get the whole numbers and compare

                'Get the number for x
                n1 = ""
                q = p
                Do While q <= Len(a(x)) And InStr("0123456789", Mid(a(x), q, 1)) <> 0
                    n1 = n1 & Mid(a(x), q, 1)
                    q = q + 1
                Loop

                'Get the number for y
                n2 = ""
                q = p
                Do While q <= Len(a(y)) And InStr("0123456789", Mid(a(y), q, 1)) <> 0
                    n2 = n2 & Mid(a(y), q, 1)
                    q = q + 1
                Loop

                If Len(n1) > Len(n2) Then
                    'n1 is a bigger number, so it should be last
                    s = True
                    Exit For
                ElseIf Len(n1) < Len(n2) Then
                    'n1 is smaller, so it should remain first
                    Exit For
                ElseIf n1 > n2 Then
                    'n1 is a bigger number, so it should be last
                    s = True
                    Exit For
                ElseIf n1 < n2 Then
                    'n1 is smaller, so it should remain first
                    Exit For
                End If
            End If
        Next

        'Do the swap
        If s Then
            c = a(y)
            a(y) = a(x)
            a(x) = c
        End If

    Next
Next

'Verify that it worked
c = ""
For p = LBound(a) To UBound(a)
    c = c & a(p) & vbCrLf
Next
MsgBox c
于 2013-10-10T20:30:27.997 回答