[已解决]excel 2003 VBA(资料自动与指定路径下的资料夹内容做比对)

lkk0063

请问excel 2003 VBA 中是否可以实现, 输入资料后自动与指定路径下的资料夹档案名称做比对, 当无资料时, 自动反红, 判定是否有此档案名称

最佳答案

月排行榜 / 总排行榜

yayahzmeng

2017-2-8 17:06

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Count > 1 Then Exit Sub
   
3.     Dim ipath$: ipath = ThisWorkbook.Path & ""
   
4.     If Target.Row = 1 And Target.Column = 5 Then
   
5.         Target.Interior.ColorIndex = 3
   
6.         Dim x$, xfile$
   
7.         x = Target.Value
   
8.         xfile = Dir(ipath)       '附件中代码指定*.pdf
   
9.         Do While xfile <> ThisWorkbook.Name And xfile <> ""
   
10.             If Left(xfile, Len(xfile) - 4) = x Then
    
11.                 Target.Interior.ColorIndex = xlNone
    
12.                 Exit Do
    
13.             End If
    
14.             xfile = Dir
    
15.         Loop
    
16.     End If
    
17. End Sub

复制代码

请测试

跳转到最佳答案楼层

yayahzmeng

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Count > 1 Then Exit Sub
   
3.     Dim ipath$: ipath = ThisWorkbook.Path & ""
   
4.     If Target.Row = 1 And Target.Column = 5 Then
   
5.         Target.Interior.ColorIndex = 3
   
6.         Dim x$, xfile$
   
7.         x = Target.Value
   
8.         xfile = Dir(ipath)       '附件中代码指定*.pdf
   
9.         Do While xfile <> ThisWorkbook.Name And xfile <> ""
   
10.             If Left(xfile, Len(xfile) - 4) = x Then
    
11.                 Target.Interior.ColorIndex = xlNone
    
12.                 Exit Do
    
13.             End If
    
14.             xfile = Dir
    
15.         Loop
    
16.     End If
    
17. End Sub

复制代码

请测试

lkk0063

Hi yayahzmeng,
刚刚测试, 确时可用, 可是只限于.pdf档案与VBA 档案在相同路径下使用, 但仍有以下问题需克服, 麻烦了
1.若想新增档案为.jpg, 可新增何处, 还是只管档案名称, 不管档案属性

yayahzmeng

1. 只要待比对的文件名中含有输入的字符就显示，也不管文件类型德话，就这样改吧：
将  If Left(xfile, Len(xfile) - 4) = x Then  改为  If instr(xfile, cstr(x)) <>0 Then 即可

2. 通常将主表和比对文件放在一个文件夹下，代码编写比较简单，而且整个文件夹可以随意挪到任何地方也不受影响。如要指定比对文件位置，要么在代码中写入绝对路径，要么shell ，代码复杂，得不偿失