|
|
Sub 匹配数据()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
w = InputBox("请输入日期", "匹配日期", "26")
If w = "" Then End
ar = ActiveSheet.[a1].CurrentRegion
For j = 8 To UBound(ar, 2)
If InStr(ar(1, j), "入库") > 0 Then
rq = Val(ar(1, j))
If rq = Val(w) Then
lh = j
Exit For
End If
End If
Next j
If lh = "" Then MsgBox "报表中没有您要匹配的日期！": Exit Sub
For i = 2 To UBound(ar)
If ar(i, 3) <> "" Then
d(ar(i, 3)) = i
End If
Next i
lj = ThisWorkbook.Path & "\"
f = Dir(lj & "销售订单批导模板-日排产订单V1.2-7.26确定版.xlsx")
If f = "" Then MsgBox "找不到销售订单批导模板-日排产订单V1.2-7.26确定版": Exit Sub
Set wb = Workbooks.Open(lj & f, 0)
With wb.Worksheets(1)
br = [a1].CurrentRegion
For j = 9 To UBound(br, 2)
If br(1, j) <> "" Then
If IsDate(br(1, j)) Then
rq = Day(br(1, j))
If Val(rq) = Val(w) Then
If br(3, j) = "实际回货数量" Then
llh = j
Exit For
End If
End If
End If
End If
Next j
If llh = "" Then MsgBox "目标表中找不到" & w & "号日期": End
For i = 2 To UBound(br)
If br(i, 5) <> "" Then
xh = d(br(i, 5))
If xh <> "" Then
br(i, llh) = ar(xh, lh)
End If
End If
Next i
.Cells(1, llh).Resize(UBound(br), 1) = Application.Index(br, 0, llh)
End With
wb.Close True
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-7-28 09:58
楼主
