Word VBAナチュラルソート

Question

配列をソートするか、Filesystemオブジェクトフォルダのファイルを、人間がソートした場合の予想通りに並べ替えたい。私が最終的に成し遂げようとしているのは、フォルダから画像を取り込んで、それが何を表しているかを識別するために、それぞれの上にテキストで単語文書に挿入するマクロです。ここではガイドのステップを使用します。 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、 STEP-20、 ステップ-7、 ステップ-8、 ステップ9

私欲しいです; ステップ-1、 ステップ-2、 ステップ-7、 ステップ-8、 ステップ-9、 ステップ-10、 ステップ-15、 STEP-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 

私は自然に並べ替えることができる2つの配列にファイル名とパスを分割します。

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') 

私はこれらを発見しました。

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