楼主
xmyjk |
Q:
1、从ME2N工作簿SHEET1中将以上A-G列复制过来，复制字段为黄色标识背景的内容。
2、按照CD列的采购凭证与项目去mb51中找对应项AB列，应该能找出多个H列的过帐日期
3、将找出来的过账时期与当前表格的交货日期去比较，早于或等于交货日期的将N列的数量相加后写入准时交货数，大于交货日期的，将N列的数量相加后写入延时交货数;
4、最终将H列准时交货数的总和除以E列的总数量算出准时交货率写入J6，将I列的延时交货数求和除以E列的总和求得百分比和写入K列
各表样式如图。
订单表：
发货表：
结果表：
A:- Sub t()
- Dim d, wb As Workbook, arr, brr(), i&, ls, j&
- Application.ScreenUpdating = False
- Set d = CreateObject("scripting.dictionary")
- Set wb = Workbooks.Open(ThisWorkbook.Path & "\mb51.xlsx") '打开发货表，讲发货表数据导入arr数组。
- arr = wb.Sheets("mb51").UsedRange.Value
- For i = 2 To UBound(arr)
- If Not d.exists(arr(i, 1) & arr(i, 2)) Then '运用字典以采购凭证+项目为关键字，讲每个关键字对应的所有发货数据以数组形式记录在字典的ITEM中。
- d(arr(i, 1) & arr(i, 2)) = Array(Replace(arr(i, 8), ".", "-") & "|" & arr(i, 14))
- Else
- ls = d(arr(i, 1) & arr(i, 2))
- ReDim Preserve ls(UBound(ls) + 1)
- ls(UBound(ls)) = Replace(arr(i, 8), ".", "-") & "|" & arr(i, 14)
- d(arr(i, 1) & arr(i, 2)) = ls
- Erase ls
- End If
- Next
- wb.Close: Erase arr
- Set wb = Nothing
- Set wb = Workbooks.Open(ThisWorkbook.Path & "\me2n.xlsx") '打开订单表，按照结果表样式，生成结果数组
- arr = wb.Sheets("Sheet1").UsedRange.Value
- ReDim brr(1 To UBound(arr) - 1, 1 To 9)
- For i = 2 To UBound(arr)
- brr(i - 1, 1) = arr(i, 1): brr(i - 1, 2) = arr(i, 2): brr(i - 1, 3) = arr(i, 4)
- brr(i - 1, 4) = arr(i, 5): brr(i - 1, 5) = arr(i, 12): brr(i - 1, 6) = arr(i, 14)
- brr(i - 1, 7) = arr(i, 15)
- If d.exists(brr(i - 1, 3) & brr(i - 1, 4)) Then '以订单表的采购凭证+项目，调出之前字典记录的发货数据数组，历遍数组，按记账日期与交货日期比对，记录数据
- ls = d(brr(i - 1, 3) & brr(i - 1, 4))
- For j = 0 To UBound(ls)
- If CDate(Replace(brr(i - 1, 7), ".", "-")) >= CDate(Split(ls(j), "|")(0)) Then
- brr(i - 1, 8) = brr(i - 1, 8) + Val(Split(ls(j), "|")(1))
- Else
- brr(i - 1, 9) = brr(i - 1, 9) + Val(Split(ls(j), "|")(1))
- End If
- Next
- Erase ls
- End If
- Next
- wb.Close: Erase arr
- Set wb = Nothing
- Set d = Nothing
- [a2].Resize(UBound(brr), UBound(brr, 2)) = brr '导出结果，并计算发货率
- [a65536].End(3).Offset(1, 9).Formula = "=-SUM(H2:H" & UBound(brr) + 1 & ")/SUM(E2:E" & UBound(brr) + 1 & ")"
- [a65536].End(3).Offset(1, 10).Formula = "=-SUM(I2:I" & UBound(brr) + 1 & ")/SUM(E2:E" & UBound(brr) + 1 & ")"
- Erase brr
- Application.ScreenUpdating = True
- End Sub
 该帖已经同步到
 Desktop.rar
|
