|
|
Sub kbtp()
Application.ScreenUpdating = False
Dim ar As Variant, br As Variant
Dim i As Long, r As Long, rs As Long
Dim d As Object
Set d = CreateObject("scripting.dictionary")
lj = ThisWorkbook.Path & "\"
Set sh = ThisWorkbook.Sheets(1)
With sh
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 3 Then MsgBox "数据表为空！": End
.Range("g3:g" & r) = Empty
ar = .Range("a1:g" & r)
End With
For i = 3 To UBound(ar)
If ar(i, 3) <> "" Then
d(ar(i, 3)) = i
End If
Next i
f = Dir(lj & "产品库.xlsx")
If f = "" Then MsgBox "找不到产品库": End
Set wb = Workbooks.Open(lj & f, 0)
With wb.Worksheets(1)
rs = .Cells(Rows.Count, 1).End(xlUp).Row
If rs < 3 Then MsgBox "产品库为空！": End
br = .Range("a1:g" & rs)
For i = 3 To UBound(br)
If br(i, 3) <> "" Then
xh = d(br(i, 3))
If xh <> "" Then
.Cells(i, 7).Copy sh.Cells(xh, 7)
End If
End If
Next i
End With
wb.Close False
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-5-14 10:17
楼主
