求助--如何检查文件夹下存在前6个字是相同的文件？

xixi0603

小弟每月都需要检查一批报表，这些报表中难免有相同的文件，命名方式类似：“XXXX_2018-05-31"，前面的6个字符都是一样的，只是后面的日期不一样，特此请教如何检查文件夹下存在前6个字是相同的文件，然后发出提示？ 求助2.rar (58.26 KB, 下载次数: 2)

2018-6-19 11:17 上传

点击文件名下载附件

-----------------在lsdongjh老师的指导下终于解决了这个问题，现在放出最后的结果，，分享给大家、！！
求助4.rar (58.45 KB, 下载次数: 2)

2018-6-19 15:21 上传

点击文件名下载附件

xixi0603

我自己写了一段代码，但是不管用啊。

1. 
   
2. Private Sub CommandButton1_Click()
   
3. Dim FilePath$, FileName$, dic As Object, obj As Object, m$, s$, p, f
   
4.     Set obj = CreateObject("Scripting.FileSystemObject")
   
5.     Set dic = CreateObject("Scripting.Dictionary")
   
6.     FilePath = ThisWorkbook.Path & "\原始表"
   
7.     FileName = Dir(FilePath & "\*.xls")
   
8.    
   
9.     Do While FileName <> ""
   
10.         m = Left(FileName, 7)
    
11.         dic(m) = dic(m) + 1
    
12.         If dic(m) = 1 Then
    
13.         MsgBox "没重复"
    
14.         Exit Sub
    
15.         Else: MsgBox "有重复"
    
16.         Exit Sub
    
17.         End If
    
18.     Loop
    
19.    
    
20. End Sub
    

复制代码

ahnyt

xixi0603 发表于 2018-6-19 11:20
我自己写了一段代码，但是不管用啊。

退出的太早了

xixi0603

ahnyt 发表于 2018-6-19 11:26
退出的太早了

不退出它就会无限循环下去，咋办呢？

xixi0603

我的思路是这样的，就是把所有文件名提取前7个字，添加到字典里，然后再统计字典里各个 名字的个数，，大于2的便提示。奈何水平有限，实现不了。。

lsdongjh

1. Private Sub CommandButton1_Click()
   
2.     Dim FilePath$, FileName$, dic As Object, obj As Object, m$, s$, p, f
   
3.     Dim blIsRepeat As Boolean
   
4.    
   
5.     Set obj = CreateObject("Scripting.FileSystemObject")
   
6.     Set dic = CreateObject("Scripting.Dictionary")
   
7.     FilePath = ThisWorkbook.Path & "\原始表"
   
8.     FileName = Dir(FilePath & "\*.xls")
   
9.     blIsRepeat = False
   
10.     Do While FileName <> ""
    
11.         m = Left(FileName, 7)
    
12.         If dic.Exists(m) = True Then
    
13.             blIsRepeat = True
    
14.             Exit Do
    
15.         End If
    
16.         dic(m) = dic(m) + 1
    
17.     Loop
    
18. 
    
19.     If blIsRepeat = True Then
    
20.         MsgBox "有重复！！"
    
21.     Else
    
22.         MsgBox "没有重复!"
    
23.     End If
    
24. End Sub
    

复制代码

xixi0603

lsdongjh 发表于 2018-6-19 12:06

我把重复的文件删除以后再试用，却还是提示有重复，怎么办呢？

lsdongjh

跟踪一下M，再说

xixi0603

lsdongjh 发表于 2018-6-19 14:52
跟踪一下M，再说

这位老师，能说得再明白点吗？怎么跟踪？

lsdongjh

F8 单步执行，看看