vba求助，文件夹中多个文件中其中一列需按规则表，替换成编码值

liuqiang_75

求助，

文件夹中多个文件其中一列（固定列：第9列，“项目9”）为名称值 ，现在需要替换成对应的编码值
对应编码在附件中的规则表。求助用VBA的方式快速实现。
求老师们帮忙!

liulang0808

Sub 按钮1_Click()
    Set fso = CreateObject("scripting.filesystemobject")
    Set d = CreateObject("scripting.dictionary")
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ThisWorkbook.Path & "\"
        .Title = "请选择对应文件夹"
        .AllowMultiSelect = False
        If .Show Then
            fd = .SelectedItems(1)
        Else
            MsgBox "未选择有效文件夹路径", vbCritical, "警告"
            End
        End If
    End With
    arr = Sheets(1).[a1].CurrentRegion
    For j = 2 To UBound(arr)
        d(arr(j, 2)) = arr(j, 1)
    Next j
        
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each f In fso.getfolder(fd).Files
        With Workbooks.Open(f)
            arr = .Sheets(1).UsedRange
            For j = 2 To UBound(arr)
                If d.exists(arr(j, 9)) Then arr(j, 9) = d(arr(j, 9))
            Next j
            .Sheets(1).UsedRange = arr
            .Save
            .Close False
        End With
    Next f
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

liulang0808

附件内容供参考。。。。

liuqiang_75

liulang0808 发表于 2023-2-2 17:15
Sub 按钮1_Click()
    Set fso = CreateObject("scripting.filesystemobject")
    Set d = CreateObjec ...

测试有效，多谢！