|
看看是否合适
Sub 照片核对()
Dim dic As Object
Dim arr
Dim i&
Dim MyPath As String, PicName As String
Dim sRow&
sRow = Cells(Rows.Count, 4).End(xlUp).Row
arr = Sheet1.Range([a3], Cells(sRow, 9))
Set dic = CreateObject("scripting.dictionary")
MyPath = ThisWorkbook.Path & "\照片\"
PicName = Dir(MyPath & "*.jpg")
Do Until PicName = ""
dic(Split(PicName, ".")(0)) = ""
PicName = Dir
Loop
For i = 1 To UBound(arr)
If dic.exists(arr(i, 4)) Then
arr(i, 8) = "OK"
Else
arr(i, 8) = "未找到"
End If
Next
[a3].Resize(UBound(arr), UBound(arr, 2)) = arr
End Sub |
评分
-
1
查看全部评分
-
|