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

lkk0063 · 发表于 2021-8-27 15:40

本帖最后由 lkk0063 于 2021-8-27 16:40 编辑

原本程式码为将资料输入至E1栏位, 会自动进入"C:\AA\" 比对档名是否存在

想改成将资料输入至E1:E65536栏位, 每个栏位自动比对档名是否存在

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
Dim ipath$: ipath = "C:\AA"
If Target.Row = 1 And Target.Column = 5 Then
Target.Interior.ColorIndex = 3
Target.Value = UCase(Target.Value)
Dim x$, xfile$, MyPath$, SPOpen$
x = Target.Value
xfile = Dir(ipath & "\.")
Do While xfile <> ""
If Left(xfile, Len(xfile) - 4) = x Then
Target.Interior.ColorIndex = xlNone
Exit Do
End If
xfile = Dir
Loop
If xfile < Target.Value Then
MsgBox "請確認是否有材質證明!"
ActiveWorkbook.FollowHyperlink "C:\AA"
End If
End If
Application.EnableEvents = True
End Sub

复制代码

最佳答案

月排行榜 / 总排行榜

excel用户1116

2021-8-27 15:53

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False

Dim ipath$: ipath = "C:\AA\"
If Target.Column = 5 Then  '修改这句试试
      Target.Interior.ColorIndex = 3
      Target.Value = UCase(Target.Value)
      Dim x$, xfile$, MyPath$, SPOpen$
      x = Target.Value
      xfile = Dir(ipath & "\.")
      Do While xfile <> ""
         If Left(xfile, Len(xfile) - 4) = x Then
            Target.Interior.ColorIndex = xlNone
            Exit Do
         End If
         xfile = Dir
      Loop
         If xfile < Target.Value Then
         MsgBox "叫絋粄琌Τ借靡!"
         ActiveWorkbook.FollowHyperlink "C:\AA\"
   End If
End If
Application.EnableEvents = True
End Sub

跳转到最佳答案楼层

excel用户1116 · 发表于 2021-8-27 15:53

这个最佳答案由 excel用户1116 给出，感谢 excel用户1116 的回答。

单击隐藏图章

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False

Dim ipath$: ipath = "C:\AA\"
If Target.Column = 5 Then  '修改这句试试
      Target.Interior.ColorIndex = 3
      Target.Value = UCase(Target.Value)
      Dim x$, xfile$, MyPath$, SPOpen$
      x = Target.Value
      xfile = Dir(ipath & "\.")
      Do While xfile <> ""
         If Left(xfile, Len(xfile) - 4) = x Then
            Target.Interior.ColorIndex = xlNone
            Exit Do
         End If
         xfile = Dir
      Loop
         If xfile < Target.Value Then
         MsgBox "叫絋粄琌Τ借靡!"
         ActiveWorkbook.FollowHyperlink "C:\AA\"
   End If
End If
Application.EnableEvents = True
End Sub

		自动登录	找回密码
密码			注册