|
|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
参与一下。。。
- Sub ykcbf() '//2024.8.21
- Set d = CreateObject("Scripting.Dictionary")
- Set d1 = CreateObject("Scripting.Dictionary")
- With Sheets("费用分摊")
- r = .Cells(Rows.Count, 3).End(3).Row
- arr = .[c1].Resize(r, 6)
- End With
- For i = 2 To UBound(arr)
- s = CStr(arr(i, 1))
- d1(s) = Array(arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 5), arr(i, 6))
- Next
- On Error Resume Next
- With Sheets("订单明细")
- r = .Cells(Rows.Count, "q").End(3).Row
- For i = 3 To r
- s = CStr(.Cells(i, "q").Value)
- d(s) = d(s) + .Cells(i, "ai").Value
- Next
- For i = 3 To r
- s = CStr(.Cells(i, "q").Value)
- n = 0
- t = d1(s)
- For j = 62 To 66
- n = n + 1
- .Cells(i, j) = .Cells(i, "ai").Value * t(n - 1) / d(s)
- Next
- Next
- End With
- MsgBox "OK！"
- End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-8-21 12:45
