我想对一个数组或文件系统对象文件夹中的文件进行排序，我们希望它们按人类排序的方式排序。我最终要完成的是一个宏，它从文件夹中获取图像并将其插入到word文档中，每个文档上面都有文本以标识它代表的内容，这里我使用步骤作为指南，这对于Step来说至关重要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， 第九步， 步骤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，我搜索的所有内容都同意＆＃34;自然排序＆＃34;是; 1,2,3，A，B，C; Apple＆lt; 1A＆lt; 1C＆lt; 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之前排序。
答案 0 :(得分：0)
这是在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