ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
123
返回列表 发新帖
楼主: 炽幻恶魔

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

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-6-1 12:56 | 显示全部楼层
炽幻恶魔 发表于 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. Set dic = CreateObject("Scripting.Dictionary")
  5. FilePath = ThisWorkbook.Path & ""
  6. Filename = Dir(FilePath & "*.xls")

  7. Do While Len(Filename)
  8.     'If Filename <> ThisWorkbook.Name Then
  9.         'dic(Filename) = Len(Filename) '测试用
  10.         Select Case Filename
  11.             Case "红.xls"
  12.                 FileArr(0) = Filename
  13.             Case "黄.xls"
  14.                 FileArr(1) = Filename
  15.             Case "绿.xls"
  16.                 FileArr(2) = Filename
  17.         End Select
  18.     'End If
  19.     Filename = Dir
  20. Loop
  21. 'MsgBox dic.KeyS()(0)
  22. 'FileArr = dic.KeyS
  23. Brr = Array("第一个是", "第二个是", "第三个是")
  24. For I = 0 To UBound(FileArr)
  25. MsgBox Brr(I) & FileArr(I) '需求二:依次弹窗显示"第一个是黄.xls"、"第二个是红.xls"、"第三个是绿.xls"
  26. Next
  27. End Sub
复制代码



TA的精华主题

TA的得分主题

发表于 2018-6-1 13:03 | 显示全部楼层
总之,思路就是用数组实现 排序,
再导入字典。
  1. Sub asdf()
  2. Dim FileArr, I, Brr
  3. ReDim FileArr(0 To 2)

  4. Set dic = CreateObject("Scripting.Dictionary")
  5. FilePath = ThisWorkbook.Path & ""
  6. Filename = Dir(FilePath & "*.xls")

  7. Do While Len(Filename)
  8.     'If Filename <> ThisWorkbook.Name Then
  9.         'dic(Filename) = Len(Filename) '测试用
  10.         Select Case Filename
  11.             Case "红.xls"
  12.                 FileArr(0) = Filename
  13.             Case "黄.xls"
  14.                 FileArr(1) = Filename
  15.             Case "绿.xls"
  16.                 FileArr(2) = Filename
  17.         End Select
  18.     'End If
  19.     Filename = Dir
  20. Loop
  21. 'MsgBox dic.KeyS()(0)
  22. 'FileArr = dic.KeyS
  23. Brr = Array("第一个是", "第二个是", "第三个是")

  24. '导入到字典
  25. For I = 0 To UBound(FileArr)
  26.     dic(FileArr(I)) = ""
  27. Next I
  28. Brr2 = dic.keys



  29. For I = 0 To UBound(FileArr)
  30. MsgBox Brr(I) & Brr2(I) '需求二:依次弹窗显示"第一个是黄.xls"、"第二个是红.xls"、"第三个是绿.xls"
  31. Next
  32. End Sub
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-6-1 14:00 | 显示全部楼层
f22cdefeh 发表于 2018-6-1 13:03
总之,思路就是用数组实现 排序,
再导入字典。

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

TA的精华主题

TA的得分主题

发表于 2018-6-1 15:54 来自手机 | 显示全部楼层
???我给你的代码都是测试过的啊。怎么会有问题?
我从现在开始外出,再次上机调试一周后了。

TA的精华主题

TA的得分主题

发表于 2018-6-1 15:58 来自手机 | 显示全部楼层
这段时间没办法上机,你好好调试一下,问题不难。
多做几个debug输出,或直接单步调试,很快就出来了。
另外,不知道你调试能力怎么样,不会调试是没法写代码的,调试技能必须掌握,磨刀不误砍柴功。你会调试了才知道问题出在哪。

TA的精华主题

TA的得分主题

发表于 2018-6-15 17:37 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
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. Set regx = CreateObject("vbscript.regexp")
  5. Set dic = CreateObject("Scripting.Dictionary")
  6. FilePath = ThisWorkbook.Path & ""
  7. Filename = Dir(FilePath & "*.xls")
  8. Do While Len(Filename)
  9.     If Filename <> ThisWorkbook.Name Then
  10.         dic(Filename) = ""
  11.     End If
  12.     Filename = Dir
  13. Loop

  14. ReDim FileArr(dic.Count, 0)
  15. For I = 0 To dic.Count - 1
  16.     'Debug.Print dic.keys()(I) '要求在不借助单元格辅助的情况下依次按日期顺序显示文件名,且要求同一天的白班排在前面,夜班排在后面。日期中单个的数字前面不能再加零。
  17.     FileArr(I, 0) = dic.keys()(I)
  18. Next
  19. 'FileArr = dic.keys()


  20. Application.DisplayAlerts = False
  21. Set sh = ThisWorkbook.Worksheets.Add
  22. sh.Name = "123"
  23. sh.Range("A1").Resize(10, 1) = FileArr
  24. sh.Range("B1").Resize(10, 1) = FileArr
  25. sh.Range("B1").Resize(100, 1).TextToColumns Destination:=Range("B1"), Other:=True, OtherChar:="月"
  26. sh.Range("C1").Resize(100, 1).TextToColumns Destination:=Range("C1"), Other:=True, OtherChar:="日"
  27. sh.Range("A1").Resize(100, 10).Sort Key1:=Range("B:B"), key2:=Range("C:C"), key3:=Range("D:D")
  28. FileArr = sh.Range("A1").Resize(dic.Count, 1)
  29. sh.Delete

  30. For I = 1 To UBound(FileArr, 1)
  31.     Debug.Print FileArr(I, 1)
  32. Next
  33. Application.DisplayAlerts = True
  34. Stop
  35. End Sub
复制代码


TA的精华主题

TA的得分主题

发表于 2018-6-15 17:39 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
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

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

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-6-19 10:45 | 显示全部楼层
f22cdefeh 发表于 2018-6-15 17:39
在“立即”窗口中的输出如下:
5月1日白班.xls
5月1日夜班.xls

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

TA的精华主题

TA的得分主题

发表于 2018-6-19 15:20 来自手机 | 显示全部楼层
恭喜你通过学习获得知识的同时肯定了自己。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-12-26 03:40 , Processed in 0.034506 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表