Question

我正在通过目录运行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

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

Answer 1

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

在这个问题上可以找到一个例子： Sort 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

Answer 2

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

Answer 3

我实际上遇到了为它构建算法的麻烦：

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

自然地在VBA中对目录进行排序

3 个答案: