Word VBA自然排序

Question

我想按照我們預期的方式對數組或文件系統對象文件夾中的文件進行排序（如果由人類排序）。我最終試圖完成的是一個宏，它從一個文件夾中獲取圖像，並將它們插入到每個文件上方的文本中，以識別它代表的內容，在這裏我使用步驟作爲指南，步驟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.正則表達式可能不錯 這就是我在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