Word VBA Natural Sorting

Question

Ich möchte ein Array oder die Dateien aus einem Dateisystem-Ordner so sortieren, wie wir es erwarten würden, wenn sie von einem Menschen sortiert würden. Was ich letztendlich zu erreichen versuche, ist ein Makro, das Bilder aus einem Ordner aufnimmt und sie in das Word-Dokument einfügt, mit Text über jedem, um zu identifizieren, was es repräsentiert, hier benutze ich Schritte für einen Leitfaden und es ist wichtig, dass Schritt 2 vor Schritt kommt 100;

Einrichten meines Test-Sub;

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 

Dann ist die einzige/beste Sortierfunktion, die ich fand, wirklich nur gut für Zahlen;

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 

Diese Funktion gibt das Array als; Step-1, Step-10, Step-100, Step-15, Step-2, Step-20, Step-7, Step-8, Step-9

aber ich wollen; Step-1, Step-2, Step-7, Step-8, Step-9, Step-10, Step-15, Step-20, Step-100

dachte ich mit StrComp (ArrayIn (i), ArrayIn (j), vbBinaryCompare/vbTextCompare) wäre ein Weg zu gehen, aber sie scheinen auf die gleiche Weise zu sortieren. Wenn es einfacher ist, gehe ich nur die Array-Route, weil ich keine Möglichkeit finden konnte, die Eingabedateien zu sortieren;

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 

Also wollte ich den Dateinamen und Pfad in zwei Arrays, die ich natürlich sortieren könnte;

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 

aber ich kann keinen Hinweis auf natürliche Sortierung in VBA finden.

Aktualisierung, zusätzliche Details;

Ich habe nicht über die A und B nach Zahlen nachgedacht und alles, was ich suche, stimmt überein, was "natürliche Sortierung" ist; 1,2,3, A, B, C; Apple < 1A < 1C < 2. Regex könnte gut sein So habe ich das in einem Python-Skript erreicht;

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

Für VBA habe ich gefunden, dass diese;

Geben Sie mir die numerische Sortierung, aber nicht die alphabetische, also 1B vor 1A sortiert.

Answer 1

Hier ist die Lösung natürlich in VBA zu sortieren

Setup/Testing

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 

Dies ist die einzige Funktion benötigt im Hauptteil aufgerufen werden;

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 

Gefunden, das war nützlich für die numerische Sortierung;

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 

Ergebnisse

Eingang:

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 

Ausgang:

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