提取的文件名（含不同长度数字）的排序问题

hourhand

附件仅供参考。更新：两种名称类型分别排序。

yuhan4488

非常感谢“3190496160”老师和“hourhand”老师
“3190496160”老师用辅助列方法，“hourhand”老师用先提取后排序方法，两位老师都成功解决了我附件中的文件名排序。

我想进一步请教老师，原附件中的文件名是同一种规则的，如“文件_部分+数字.pdf”
如果文件夹中的文件名有多种规则，如有纯数字的1.pdf，2.pdf，10.pdf，还有 文件_部分1.pdf，文件_部分2.pdf，文件_部分11.pdf等等，该怎么进一步处理？

hourhand

yuhan4488 发表于 2021-9-25 14:57
非常感谢“3190496160”老师和“hourhand”老师
“3190496160”老师用辅助列方法，“ ...

因我的代码是使用了正则表达式，提取文件名中的数字之后再排序的方式，可能排序后造成“1.pdf”在“文件_部分2.pdf”之前，这就要看你需要的排序方式了。

yuhan4488

hourhand 发表于 2021-9-25 16:11
因我的代码是使用了正则表达式，提取文件名中的数字之后再排序的方式，可能排序后造成“1.pdf”在“文件_ ...

老师，您好。
我没有特殊的排序要求，只要求所有文件按文件夹中的排序方式即可。文件夹中的排序是：1.pdf，2.pdf，11.pdf， 文件_部分1.pdf，文件_部分2.pdf......文件_部分10.pdf......
如下图所示：

yuhan4488

想进一步请教各位老师：
如果文件夹中的文件名有多种规则，
如有纯数字的1.pdf，2.pdf，10.pdf，还有 文件_部分1.pdf，文件_部分2.pdf，文件_部分11.pdf等等，该怎么进一步处理，让所有文件名按文件夹中的顺序排序？
如下图

李水碾人

hourhand 发表于 2021-9-24 19:31
其实这样的问题以前也遇到过，我的办法是把数字1写成01，数字2写成02就可以正常和其他两位数的进行排序，如 ...

您的办法是最简单的方法，这样用dir函数获取最简单。我试过了完全没有问题。受教了，多谢

smiletwo

smiletwo

1. Private Sub tq()
   
2.     Dim i%, num%, arr, reg As Object
   
3.     Application.ScreenUpdating = False
   
4.     Set fso = CreateObject("scripting.filesystemobject")
   
5.     Set f = fso.getfolder(ThisWorkbook.Path & "")
   
6.     Set ff = f.Files
   
7.     num = ff.Count
   
8.     ReDim arr(1 To num - 2, 1 To 2)
   
9.     Set reg = CreateObject("vbscript.regexp")
   
10.     reg.Global = True
    
11.     reg.Pattern = "[0-9]+"
    
12.     For Each kkk In ff
    
13.       If kkk.Name <> ThisWorkbook.Name And reg.test(kkk.Name) Then
    
14.         k = k + 1
    
15.         arr(k, 1) = kkk.Name
    
16.         arr(k, 2) = reg.Execute(kkk.Name)(0)
    
17.       End If
    
18.     Next
    
19.     Sheet2.Range("A2").Resize(UBound(arr), UBound(arr, 2)) = arr
    
20.    
    
21.     '----排序--以下为录制宏代码
    
22.     Range("A2:B13").Select
    
23.     ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear
    
24.     ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("B2:B13") _
    
25.         , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
26.     With ActiveWorkbook.Worksheets("Sheet2").Sort
    
27.         .SetRange Range("A2:B13")
    
28.         .Header = xlGuess
    
29.         .MatchCase = False
    
30.         .Orientation = xlTopToBottom
    
31.         .SortMethod = xlPinYin
    
32.         .Apply
    
33.     End With
    
34.     Application.ScreenUpdating = True
    
35. End Sub
    

复制代码