|
|
Sub 数据匹配()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
f = Dir(ThisWorkbook.Path & "\序列号.xls*")
If f = "" Then MsgBox "找不到序列号文件！": End
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f, 0)
br = wb.Worksheets(1).[a1].CurrentRegion
wb.Close False
For i = 2 To UBound(br)
zd = ""
If br(i, 1) <> "" And br(i, 2) <> "" Then
zf = br(i, 1) & "|" & br(i, 2) & "|" & br(i, 3) & "|" & br(i, 4)
d(zf) = i
End If
Next i
With Sheets("sheet3")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 3 Then MsgBox "箱单数据为空！": End
.Range("d3:e" & r) = Empty
ar = .Range("a1:r" & r)
For i = 3 To UBound(ar)
zf = "": m = ""
If ar(i, 1) <> "" And ar(i, 2) <> "" Then
For j = 6 To 15
If ar(i, j) <> "" Then
m = ar(i, j)
Exit For
End If
Next j
If m <> "" Then
zf = ar(i, 1) & "|" & ar(i, 2) & "|" & m & "|" & ar(i, 17)
xh = d(zf)
If xh <> "" Then
ar(i, 4) = br(xh, 5)
ar(i, 5) = br(xh, 6)
End If
End If
End If
Next i
.[d1].Resize(UBound(ar), 1) = Application.Index(ar, 0, 4)
.[e1].Resize(UBound(ar), 1) = Application.Index(ar, 0, 5)
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-8-23 11:55
