如何按照附件中的b列来重命名图片？

zzpsx

https://fast.uc.cn/s/4a0fe66314894 点击链接接收文件 [重命名规则.zip]

3190496160

Sub 重命名()
Dim ar As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets(1)
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:b" & r)
End With
For i = 1 To UBound(ar)
    If Trim(ar(i, 1)) <> "" And Trim(ar(i, 2)) <> "" Then
        zd = "图 (" & ar(i, 1) & ")"
        d(zd) = ar(i, 2)
    End If
Next i
f = Dir(ThisWorkbook.Path & "\*.jpg")
On Error Resume Next
Do While f <> ""
    mc = Replace(f, ".jpg", "")
    If d.exists(mc) Then
        m = d(mc)
        Name ThisWorkbook.Path & "\" & f As ThisWorkbook.Path & "\" & m
    End If
f = Dir
Loop
MsgBox "ok!"
End Sub

3190496160

半百

zzpsx

谢谢各位，问题已经解决。