请教一个获取目录下所有文件名的问题

f22cdefeh

炽幻恶魔 发表于 2018-6-1 11:38
说的有道理，受教！另外我长时间没有在论坛回复，忘了这点，已经重开了一贴……你的代码具体怎么写，我自 ...

嗯，……1、我不知道你为什么执意要用字典，如果是为了实验学习字典那没什么，如果现实应用的话可能思路上有误区。
因为字典是 key-item 对应的，所以字典本身是无序的。而数组因为下标是顺序的，所以它可以对顺序敏感。
2、看你原来的代码：先把文件名放字典中，然后又导出到数组，按顺序输出。你为何不直接放数组中呢？所以我把你的字典部分直接给注释掉了，用数组来实现顺序的问题。
3、如果你后面还要用到字典，那就简单了，写个循环，把数组按顺序导出到字典就行了。

1. Sub asdf()
   
2. Dim FileArr, I, Brr
   
3. ReDim FileArr(0 To 2)
   
4. 
   
5. Set dic = CreateObject("Scripting.Dictionary")
   
6. FilePath = ThisWorkbook.Path & ""
   
7. Filename = Dir(FilePath & "*.xls")
   
8. 
   
9. Do While Len(Filename)
   
10.     'If Filename <> ThisWorkbook.Name Then
    
11.         'dic(Filename) = Len(Filename) '测试用
    
12.         Select Case Filename
    
13.             Case "红.xls"
    
14.                 FileArr(0) = Filename
    
15.             Case "黄.xls"
    
16.                 FileArr(1) = Filename
    
17.             Case "绿.xls"
    
18.                 FileArr(2) = Filename
    
19.         End Select
    
20.     'End If
    
21.     Filename = Dir
    
22. Loop
    
23. 'MsgBox dic.KeyS()(0)
    
24. 'FileArr = dic.KeyS
    
25. Brr = Array("第一个是", "第二个是", "第三个是")
    
26. For I = 0 To UBound(FileArr)
    
27. MsgBox Brr(I) & FileArr(I) '需求二：依次弹窗显示"第一个是黄.xls"、"第二个是红.xls"、"第三个是绿.xls"
    
28. Next
    
29. End Sub
    

复制代码

f22cdefeh

总之，思路就是用数组实现 排序，
再导入字典。

1. Sub asdf()
   
2. Dim FileArr, I, Brr
   
3. ReDim FileArr(0 To 2)
   
4. 
   
5. Set dic = CreateObject("Scripting.Dictionary")
   
6. FilePath = ThisWorkbook.Path & ""
   
7. Filename = Dir(FilePath & "*.xls")
   
8. 
   
9. Do While Len(Filename)
   
10.     'If Filename <> ThisWorkbook.Name Then
    
11.         'dic(Filename) = Len(Filename) '测试用
    
12.         Select Case Filename
    
13.             Case "红.xls"
    
14.                 FileArr(0) = Filename
    
15.             Case "黄.xls"
    
16.                 FileArr(1) = Filename
    
17.             Case "绿.xls"
    
18.                 FileArr(2) = Filename
    
19.         End Select
    
20.     'End If
    
21.     Filename = Dir
    
22. Loop
    
23. 'MsgBox dic.KeyS()(0)
    
24. 'FileArr = dic.KeyS
    
25. Brr = Array("第一个是", "第二个是", "第三个是")
    
26. 
    
27. '导入到字典
    
28. For I = 0 To UBound(FileArr)
    
29.     dic(FileArr(I)) = ""
    
30. Next I
    
31. Brr2 = dic.keys
    
32. 
    
33. 
    
34. 
    
35. For I = 0 To UBound(FileArr)
    
36. MsgBox Brr(I) & Brr2(I) '需求二：依次弹窗显示"第一个是黄.xls"、"第二个是红.xls"、"第三个是绿.xls"
    
37. Next
    
38. End Sub
    

复制代码

炽幻恶魔

f22cdefeh 发表于 2018-6-1 13:03
总之，思路就是用数组实现 排序，
再导入字典。

感谢你的耐心帮助，我之所以先用字典后导入数组，只是因为我只会通过这种方法实现附件中需求的功能，无奈之下只好这样操作。但是你给的代码，第一段我运行后，弹窗只有前面的第一个是啥、第二个是啥，没有文件名了。第二个直接运行不通过，提示下标越界。我实际需要的是日期加附带的汉字排序，不会描述，只好这样了。不行你看看我附件的文件吧，那些文件可以正确排序吗？ 班次排序.rar (49.73 KB, 下载次数: 14)

2018-6-1 14:00 上传

点击文件名下载附件

f22cdefeh

???我给你的代码都是测试过的啊。怎么会有问题？
我从现在开始外出，再次上机调试一周后了。

f22cdefeh

这段时间没办法上机，你好好调试一下，问题不难。
多做几个debug输出，或直接单步调试，很快就出来了。
另外，不知道你调试能力怎么样，不会调试是没法写代码的，调试技能必须掌握，磨刀不误砍柴功。你会调试了才知道问题出在哪。

f22cdefeh

1、显然你的文件名排序是有要求的，不是简单的红黄蓝，而是【按文件名所述的日期排序】，所

以你问题描述不清我给你的代码就用不成。
2、下标越界，因为数组下标默认是0开始即0-9，而dic.count是10。
3、你须明确你的工程需要什么，才能决定用什么代码实现，否则无用功。
4、我再强调一次，字典本身不能排序，要排序放到数组中。
5、调试的时候用debug.print比 msgbox方便一些，会跟踪调试最好，想写长代码就先学调试，否

则累死。
6、关于排序方法：你的排序要求，借用表格的“分列”和“排序”功能，逻辑上好理解一些，不知道

你为什么不用。如果纯代码，涉及到字符串处理和排序算法，很累的，没有功底还是别碰为好。
下面有个借用单元格排序的法子 ，纯代码排序太累，要拆字符串，要循环比较，我不想弄。

1. Sub asdf()
   
2. Dim FileArr, I, Brr()
   
3. Dim regx
   
4. 
   
5. Set regx = CreateObject("vbscript.regexp")
   
6. Set dic = CreateObject("Scripting.Dictionary")
   
7. FilePath = ThisWorkbook.Path & ""
   
8. Filename = Dir(FilePath & "*.xls")
   
9. Do While Len(Filename)
   
10.     If Filename <> ThisWorkbook.Name Then
    
11.         dic(Filename) = ""
    
12.     End If
    
13.     Filename = Dir
    
14. Loop
    
15. 
    
16. ReDim FileArr(dic.Count, 0)
    
17. For I = 0 To dic.Count - 1
    
18.     'Debug.Print dic.keys()(I) '要求在不借助单元格辅助的情况下依次按日期顺序显示文件名，且要求同一天的白班排在前面，夜班排在后面。日期中单个的数字前面不能再加零。
    
19.     FileArr(I, 0) = dic.keys()(I)
    
20. Next
    
21. 'FileArr = dic.keys()
    
22. 
    
23. 
    
24. Application.DisplayAlerts = False
    
25. Set sh = ThisWorkbook.Worksheets.Add
    
26. sh.Name = "123"
    
27. sh.Range("A1").Resize(10, 1) = FileArr
    
28. sh.Range("B1").Resize(10, 1) = FileArr
    
29. sh.Range("B1").Resize(100, 1).TextToColumns Destination:=Range("B1"), Other:=True, OtherChar:="月"
    
30. sh.Range("C1").Resize(100, 1).TextToColumns Destination:=Range("C1"), Other:=True, OtherChar:="日"
    
31. sh.Range("A1").Resize(100, 10).Sort Key1:=Range("B:B"), key2:=Range("C:C"), key3:=Range("D:D")
    
32. FileArr = sh.Range("A1").Resize(dic.Count, 1)
    
33. sh.Delete
    
34. 
    
35. For I = 1 To UBound(FileArr, 1)
    
36.     Debug.Print FileArr(I, 1)
    
37. Next
    
38. Application.DisplayAlerts = True
    
39. Stop
    
40. End Sub
    

复制代码

f22cdefeh

f22cdefeh 发表于 2018-6-15 17:37
1、显然你的文件名排序是有要求的，不是简单的红黄蓝，而是【按文件名所述的日期排序】，所

以你问题描 ...

在“立即”窗口中的输出如下：
5月1日白班.xls
5月1日夜班.xls
5月2日白班.xls
5月2日夜班.xls
5月10日白班.xls
5月10日夜班.xls
5月11日白班.xls
5月11日夜班.xls
5月20日白班.xls
5月20日夜班.xls

我想这应该是你想要的顺序。

炽幻恶魔

f22cdefeh 发表于 2018-6-15 17:39
在“立即”窗口中的输出如下：
5月1日白班.xls
5月1日夜班.xls

非常感谢你的帮助，我已经弄好了，确实搞了很长的代码，不过还是很有成就感~谢谢你的帮助!

f22cdefeh

恭喜你通过学习获得知识的同时肯定了自己。