|
首批缺料日和需求数量抓不到,请大家帮忙看看以下代码应该怎样修正?
Sub test2()
Dim t
t = Timer
Dim r&, i&
Dim arr, brr
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Worksheets("采购数据")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
c = .Cells(2, .Columns.Count).End(xlToLeft).Column
.Range("av3").Resize(r - 2, c - 46).ClearContents
arr = .Range("a2").Resize(r - 1, c)
For i = 2 To UBound(arr)
xm = arr(i, 2) & "+" & arr(i, 3)
d(xm) = i
Next
End With
With Worksheets("sys")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
brr = .Range("a2:h" & r)
For i = 1 To UBound(brr)
xm = brr(i, 7) & "+" & brr(i, 3)
If d.exists(xm) Then
m = d(xm)
If brr(i, 1) >= arr(1, 49) And brr(i, 1) <= arr(1, UBound(arr, 2)) Then
n = DateDiff("d", arr(1, 49), brr(i, 1)) * 2 + 49
arr(m, n) = arr(m, n) + brr(i, 6)
End If
End If
Next
End With
For i = 2 To UBound(arr)
arr(i, 49) = arr(i, 10) + arr(i, 11) - arr(i, 48)
For j = 51 To UBound(arr, 2) Step 2
arr(i, j) = arr(i, j - 2) - arr(i, j - 1)
Next
For j = 48 To UBound(arr, 2) Step 2
If arr(i, j) < 0 Then
Exit For
End If
Next
If j <= UBound(arr, 2) Then
arr(i, 46) = arr(1, j)
Else
arr(i, 46) = ""
End If
Next
With Worksheets("采购数据")
.Range("a2").Resize(UBound(arr), UBound(arr, 2)) = arr
End With
MsgBox "计算完成,总运行时间为" & Timer - t & "秒"
End Sub
|
|