文件重组移动

huangdiP4

求助
在录入20220605文件夹中，将材料汇总excel中的列表值从文件夹《图集》找出，差将图纸另存入《录入图集》中。
例如：在材料汇总中材料编码11X11在《图集》找到，找到后，并将这线图存入《录入图集》中，然后再进行下一个，直至excel表格中最后一个编码找到，并存入《录入图集》中

huangdiP4

附件，上面没有看到附件，再次发一下，请谅解

3190496160

ub 查找()
Dim ar As Variant, cr As Variant
Dim i As Long, r As Long, rs As Long
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("sheet1")
    rs = .Cells(Rows.Count, 1).End(xlUp).Row
    .Range("b2:b" & rs) = Empty
    ar = .Range("a1:b" & rs)
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            zd = Trim(ar(i, 1)) & ".dwg"
            d(zd) = i
        End If
    Next i
    f = Dir(ThisWorkbook.Path & "\图集\*.dwg")
    Do While f <> ""
        xh = d(f)
        If xh <> "" Then
            m = m + 1
            FileCopy ThisWorkbook.Path & "\图集\" & f, ThisWorkbook.Path & "\录入图集\" & f
            ar(xh, 2) = "找到"
        End If
    f = dor
    Loop
    .Range("a1:b" & rs) = ar
End With
MsgBox "找到了" & m & "个"
End Sub

3190496160

目前物料名称跟文件名称不完全一致，代码仅供参考
录入20220605.rar (1.12 MB, 下载次数: 3)

2022-6-6 09:17 上传

点击文件名下载附件