如何自动分配油耗？？

附件

分配油耗.rar(2.18 KB)

2011-8-12 10:37, 下载次数: 6

复制内容到剪贴板

代码:

Dim arr, d As Object, brr(), i&, x1, x2
Set d = CreateObject("scripting.dictionary")
arr = Range("a2:d" & Range("b65536").End(xlUp).Row)
ReDim brr(1 To UBound(arr), 1 To 1)
x1 = arr(1, 1): x2 = arr(1, 4)
For i = 2 To UBound(arr)
    If arr(i, 1) = "" Then arr(i, 1) = x1 Else x1 = arr(i, 1)
    If arr(i, 4) = "" Then arr(i, 4) = x2 Else x2 = arr(i, 4)
Next i
For i = 1 To UBound(arr)
    d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 3)
Next i
For i = 1 To UBound(arr)
    brr(i, 1) = arr(i, 4) * arr(i, 3) / d(arr(i, 1))
Next i
Range("e2").Resize(UBound(brr), 1) = brr

分配油耗.rar (7.4 KB)
下载次数: 5