词VBA自然排序

Question

我想对数组或Filesystemobject文件夹中的文件进行排序，就像我们期望的那样，如果按人排序的话。我最终想要完成的是一个宏，该宏从文件夹中获取图像并将它们插入word文档中，并将它们插入到每个文件上面的文本中，以确定其所代表的内容，这里我使用步骤作为指南，步骤2在步骤100之前完成是非常重要的；

设置我的测试潜艇；

Sub RunTheSortMacro()

Dim i As Long
Dim myArray As Variant

'Set the array
myArray = Array("Step-1", "Step-2", "Step-10", "Step-15", "Step-9", "Step-20", "Step-100", "Step-8", "Step-7")

'myArray variable set to the result of SortArray function
myArray = SortArray(myArray)

'Output the Array through a message box
For i = LBound(myArray) To UBound(myArray)
    MsgBox myArray(i)
Next i

End Sub

那么，我找到的唯一/最好的排序函数实际上只适合于数字；

Function SortArray(ArrayIn As Variant)

Dim i As Long
Dim j As Long
Dim Temp

'Sort the Array A-Z
  For i = LBound(ArrayIn) To UBound(ArrayIn)
    For j = i + 1 To UBound(ArrayIn)
      If ArrayIn(i) > ArrayIn(j) Then
        SrtTemp = ArrayIn(j)
        ArrayIn(j) = ArrayIn(i)
        ArrayIn(i) = SrtTemp
      End If
    Next j
  Next i

SortArray = ArrayIn

End Function

该函数将数组返回为:步骤1、步骤10、步骤100、步骤15、步骤2、步骤20、步骤7、步骤8、步骤9。

但是我要，步骤1，步骤2，步骤7，步骤8，步骤9，步骤10，步骤15，步骤20，步骤100

我认为使用StrComp(ArrayIn(i)、ArrayIn(j)、vbBinaryCompare/vbTextCompare)是一种方法，但它们的排序方式似乎是相同的。如果更简单的话，我只选择数组路径，因为我找不到一种方法来对输入文件进行排序；

    Set objFSO = CreateObject("Scripting.Filesystemobject")
    Set Folder = objFSO.GetFolder(FolderPath)
    For Each image In Folder.Files
        ImagePath = image.Path
        Selection.TypeText Text:=Left(image.Name, Len(image.Name) - 4)
        Selection.TypeText Text:=vbCr
        'Insert the images into the word document
        Application.Selection.EndKey END_OF_STORY, MOVE_SELECTION
        Application.Selection.InlineShapes.AddPicture (ImagePath)
        Application.Selection.InsertBreak  'Insert a pagebreak
    Next

所以我要把文件名和路径分解成两个数组，我可以自然排序；

    Set objFiles = Folder.Files
    FileCount = objFiles.Count
    ReDim imageNameArray(FileCount)
    ReDim imagePathArray(FileCount)
    icounter = 0
    For Each image In Folder.Files
        imageNameArray(icounter) = (image.Name)
        imagePathArray(icounter) = (image.Path)
        icounter = icounter + 1
    Next

但我在VBA中找不到任何关于自然排序的参考。

更新，附加细节；

我没有想到数字之后的A和B，我搜索的所有东西都同意什么是“自然排序”；1, 2 ,3，A，B，C；Apple < 1A < 1C <2。Regex可能很好，这就是我如何在python脚本中实现这一点的；

import os
import re

def tryint(s):
    try:
        return int(s)
    except:
        return s

def alphanum_key(s):
    """ Turn a string into a list of string and number chunks.
        "z23a" -> ["z", 23, "a"]
    """
    return [ tryint(c) for c in re.split('([0-9]+)', s) ]

def sort_nicely(l):
    """ Sort the given list in the way that humans expect.
    """
    l.sort(key=alphanum_key)
files = [file for file in os.listdir(".") if (file.lower().endswith('.png')) or (file.lower().endswith('.jpg'))]
files.sort(key=alphanum_key)

for file in sorted(files,key=alphanum_key):
    stepname = file.strip('.jpg')
    print(stepname.strip('.png')

对于VBA，我发现这些；

Function SortArray(ArrayIn As Variant)

Dim i As Long
Dim j As Long
Dim Temp1 As String
Dim Temp2 As String
Dim Temp3 As String
Dim Temp4 As String

'Sort the Array A-Z
    For i = LBound(ArrayIn) To UBound(ArrayIn)
        For j = i + 1 To UBound(ArrayIn)
            Temp1 = ArrayIn(i)
            Temp2 = ArrayIn(j)
            Temp3 = onlyDigits(Temp1)
            Temp4 = onlyDigits(Temp2)

            If Val(Temp3) > Val(Temp4) Then
                ArrayIn(j) = Temp1
                ArrayIn(i) = Temp2
            End If
        Next j
    Next i
SortArray = ArrayIn

End Function

Function onlyDigits(s As String) As String
    ' Variables needed (remember to use "option explicit").   '
    Dim retval As String    ' This is the return string.      '
    Dim i As Integer        ' Counter for character position. '

    ' Initialise return string to empty                       '
    retval = ""

    ' For every character in input string, copy digits to     '
    '   return string.                                        '
    For i = 1 To Len(s)
        If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Then
            retval = retval + Mid(s, i, 1)
        End If
    Next

    ' Then return the return string.                          '
    onlyDigits = retval
End Function

给我数字排序，但不是字母排序，所以1B是排序之前1A。

Answer 1

下面是在VBA中自然排序的解决方案

设置/测试

Sub RunTheSortMacro()

Dim i As Long
Dim myArray As Variant

'Set the array
myArray = Array("Step 15B.png", "Cat 3.png", "Step 1.png", "Step 2.png", "Step 15C.png", "Dog 1.png", "Step 10.png", "Step 15A.png", "Step 9.png", "Step 20.png", "Step 100.png", "Step 8.png", "Step 7Beta.png", "Step 7Alpha.png")

'myArray variable set to the result of SortArray function
myArray = SortArray(myArray)

For i = LBound(myArray) To UBound(myArray)
    Debug.Print myArray(i)
Next


End Sub

这是主要部分中唯一需要调用的功能；

Function SortArray(ArrayIn As Variant)

Dim i As Long
Dim j As Long
Dim Temp1 As String
Dim Temp2 As String
Dim myRegExp, myRegExp2, Temp3, Temp4, Temp5, Temp6, regExp1_Matches, regExp2_Matches

'Number and what's after the number
Set myRegExp = CreateObject("vbscript.regexp")
myRegExp.IgnoreCase = True
myRegExp.Global = True
myRegExp.pattern = "[0-9][A-Z]"

'Text up to a number or special character
Set myRegExp2 = CreateObject("vbscript.regexp")
myRegExp2.IgnoreCase = True
myRegExp2.Global = True
myRegExp2.pattern = "^[A-Z]+"

'Sort by Fisrt Text and number
For i = LBound(ArrayIn) To UBound(ArrayIn)
    For j = i + 1 To UBound(ArrayIn)
        Temp1 = ArrayIn(i)
        Temp2 = ArrayIn(j)
        Temp3 = onlyDigits(Temp1)
        Temp4 = onlyDigits(Temp2)
        Set regExp1_Matches = myRegExp2.Execute(Temp1)
        Set regExp2_Matches = myRegExp2.Execute(Temp2)
        If regExp1_Matches.Count = 1 And regExp2_Matches.Count = 1 Then 'eliminates blank/empty strings
        If regExp1_Matches(0) > regExp2_Matches(0) Then
            ArrayIn(j) = Temp1
            ArrayIn(i) = Temp2
        ElseIf regExp1_Matches(0) = regExp2_Matches(0) Then
            If Val(Temp3) > Val(Temp4) Then
                ArrayIn(j) = Temp1
                ArrayIn(i) = Temp2
            End If
        End If
        End If
    Next j
Next i
'Sort the array again by taking two at a time finds number followed by letters and sorts the two alphabetically, ex 1A, 1B
    For i = LBound(ArrayIn) To (UBound(ArrayIn) - 1)
        j = i + 1
            Temp1 = ArrayIn(i)
            Temp2 = ArrayIn(j)
            Set regExp1_Matches = myRegExp.Execute(Temp1)
            Set regExp2_Matches = myRegExp.Execute(Temp2)
            If regExp1_Matches.Count = 1 And regExp2_Matches.Count = 1 Then
                If regExp1_Matches(0) > regExp2_Matches(0) Then
                    ArrayIn(j) = Temp1
                    ArrayIn(i) = Temp2
                End If
            End If
    Next i
SortArray = ArrayIn

End Function

发现这对数值分类是有用的；

Function onlyDigits(s As String) As String
    ' Variables needed (remember to use "option explicit").   '
    Dim retval As String    ' This is the return string.      '
    Dim i As Integer        ' Counter for character position. '

    ' Initialise return string to empty                       '
    retval = ""

    ' For every character in input string, copy digits to     '
    '   return string.                                        '
    For i = 1 To Len(s)
        If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Then
            retval = retval + Mid(s, i, 1)
        End If
    Next

    ' Then return the return string.                          '
    onlyDigits = retval
End Function

结果

输入：

Step 15B.png
Cat 3.png
Step 1.png
Step 2.png
Step 15C.png
Dog 1.png
Step 10.png
Step 15A.png
Step 9.png
Step 20.png
Step 100.png
Step 8.png
Step 7Beta.png
Step 7Alpha.png

输出：

Cat 3.png
Dog 1.png
Step 1.png
Step 2.png
Step 7Alpha.png
Step 7Beta.png
Step 8.png
Step 9.png
Step 10.png
Step 15A.png
Step 15B.png
Step 15C.png
Step 20.png
Step 100.png