[已解决]求助各位大佬，在线等

skyhawkf119

现有一堆文件存放在C:\data 目录，目录中有excel表 A列是当前目录中的文件名（1， 2,3），B列是分类名称（c1，c2, c3）
需要做的工作是通过excel表中的文件名搜索C:\data 目录是否有该文件，如果有，则将其拷贝到B列名称的文件夹（已手工在C:\data 目录创建好）中。如何实现？求大佬们赐教！本人是初学者。

感谢大神的热心帮助，附件是需要处理的文件内容，弱弱请教如何自动自动确定数据表中数据项数？

最佳答案

月排行榜 / 总排行榜

高

2015-10-17 07:22

1. Sub 移动()
   
2. Dim x
   
3. Dim arr
   
4. mypath = "c:\date"
   
5. myfile = Dir(mypath & "*.xls")
   
6. Do Until Len(myfile) = 0
   
7.    arr = Range("a1:b3")
   
8.    For x = 1 To UBound(arr)
   
9.    If arr(x, 1) & ".xls" = myfile Then
   
10.    FileCopy (mypath & arr(x, 1) & ".xls"), mypath & arr(x, 2) & "" & arr(x, 1) & ".xls"
    
11. 
    
12.      Kill mypath & arr(x, 1) & ".xls"
    
13. 
    
14.     End If
    
15.     Next
    
16.    
    
17.     myfile = Dir
    
18. Loop
    
19. 
    
20. myfile = Dir(mypath & "*.xlsx")
    
21. Do Until Len(myfile) = 0
    
22.    arr = Range("a1:b3")
    
23.    For x = 1 To UBound(arr)
    
24.    If arr(x, 1) & ".xlsx" = myfile Then
    
25.    FileCopy (mypath & arr(x, 1) & ".xlsx"), mypath & arr(x, 2) & "" & arr(x, 1) & ".xlsx"
    
26. 
    
27.      Kill mypath & arr(x, 1) & ".xlsx"
    
28. 
    
29.     End If
    
30.     Next
    
31.    
    
32.     myfile = Dir '选中下一个文件
    
33. Loop
    
34. End Sub
    

复制代码

你那个有文件名的文件要放在C盘date目录之外，将代码放在该工作表内。

跳转到最佳答案楼层

tzjx200521

请上传附件。

高

你要不要把那个目录表发过来看一下，另外，好像还要知道你的excel文件名的后缀吧

高

1. Sub 移动()
   
2. Dim x
   
3. Dim arr
   
4. mypath = "c:\date"
   
5. myfile = Dir(mypath & "*.xls")
   
6. Do Until Len(myfile) = 0
   
7.    arr = Range("a1:b3")
   
8.    For x = 1 To UBound(arr)
   
9.    If arr(x, 1) & ".xls" = myfile Then
   
10.    FileCopy (mypath & arr(x, 1) & ".xls"), mypath & arr(x, 2) & "" & arr(x, 1) & ".xls"
    
11. 
    
12.      Kill mypath & arr(x, 1) & ".xls"
    
13. 
    
14.     End If
    
15.     Next
    
16.    
    
17.     myfile = Dir
    
18. Loop
    
19. 
    
20. myfile = Dir(mypath & "*.xlsx")
    
21. Do Until Len(myfile) = 0
    
22.    arr = Range("a1:b3")
    
23.    For x = 1 To UBound(arr)
    
24.    If arr(x, 1) & ".xlsx" = myfile Then
    
25.    FileCopy (mypath & arr(x, 1) & ".xlsx"), mypath & arr(x, 2) & "" & arr(x, 1) & ".xlsx"
    
26. 
    
27.      Kill mypath & arr(x, 1) & ".xlsx"
    
28. 
    
29.     End If
    
30.     Next
    
31.    
    
32.     myfile = Dir '选中下一个文件
    
33. Loop
    
34. End Sub
    

复制代码

你那个有文件名的文件要放在C盘date目录之外，将代码放在该工作表内。

skyhawkf119

高 发表于 2015-10-17 07:22
你那个有文件名的文件要放在C盘date目录之外，将代码放在该工作表内。

已上传数据表，请大神看，我自己改了一下您提供的代码，可用，弱弱问，如何自动识别需要处理数据表数据项数呢？目前是设定了a1：b3。还有一种情况是表中的文件名，在数据目录里面可能没有，这个在代码中怎么处理呢？

wp8680

Sub 移动()
    Dim x
    Dim arr
    On Error Resume Next
    mypath = ThisWorkbook.Path & "\data\"
    arr = Range("a1:b" & Range("b" & Cells.Rows.Count).End(xlUp).Row)
    For x = 1 To UBound(arr)
        Name mypath & arr(x, 1) & ".pdf" As mypath & arr(x, 2) & "\" & arr(x, 1) & ".pdf"
    Next x
End Sub


就这几句就行了。凡是表中不存在的文件不会移动，凡是符合移动条件的都会移至对应的位置。

wp8680

要想移动其他类型的，修改
Name mypath & arr(x, 1) & ".pdf" As mypath & arr(x, 2) & "\" & arr(x, 1) & ".pdf"
这句中的文件后缀名就行了。