楼主
xyf2210 |
Q:如何使用代码替代函数公式运行j计算？
A:- Sub test()
- Dim d, arr, brr, crr(), i, j, temp
- Set d = CreateObject("scripting.dictionary")
- arr = Range("a1").CurrentRegion
- brr = Sheets("采购入库").Range("a1").CurrentRegion
- temp = 0
- For i = 2 To UBound(brr)
- If Not d.exists(brr(i, 1) & brr(i, 2)) Then
- temp = temp + 1
- d(brr(i, 1) & brr(i, 2)) = temp
- ReDim Preserve crr(1 To 14, 1 To temp)
- crr(1, temp) = brr(i, 1)
- crr(2, temp) = brr(i, 2)
- For j = 3 To 14
- crr(j, temp) = brr(i, j)
- Next
- Else
- For j = 3 To 14
- crr(j, d(brr(i, 1) & brr(i, 2))) = crr(j, d(brr(i, 1) & brr(i, 2))) + brr(i, j)
- Next
- End If
- Next
- For i = 2 To UBound(arr)
- d(arr(i, 5)) = d(arr(i, 5)) + 1
- arr(i, 43) = IIf(d(arr(i, 5)) > 1, 0, 1)
- d(arr(i, 6)) = d(arr(i, 6)) + 1
- If d(arr(i, 5)) > 1 And d(arr(i, 6)) > 1 Then
- arr(i, 44) = 0
- Else
- arr(i, 44) = 1
- End If
- If d.exists(arr(i, 5) & arr(i, 6)) Then
- For j = 19 To 30
- arr(i, j) = crr(j - 16, d(arr(i, 5) & arr(i, 6)))
- If j <> 30 Then
- arr(i, j + 12) = IIf(arr(i, j - 12) - arr(i, j) > 0, arr(i, j - 12) - arr(i, j), 0)
- arr(i, j + 28) = IIf(arr(i, j - 12) - arr(i, j) < 0, arr(i, j - 12) - arr(i, j), 0)
- Else
- arr(i, j + 12) = Application.Sum(arr(i, 31), arr(i, 32), arr(i, 33), arr(i, 34), arr(i, 35) _
- , arr(i, 36), arr(i, 37), arr(i, 38), arr(i, 39), arr(i, 40), arr(i, 41))
- arr(i, j + 28) = Application.Sum(arr(i, 47), arr(i, 48), arr(i, 49), arr(i, 50), arr(i, 51) _
- , arr(i, 52), arr(i, 53), arr(i, 54), arr(i, 55), arr(i, 56), arr(i, 57))
- End If
- Next
- End If
- Next
- For i = 1 To UBound(arr)
- d(arr(i, 5) & "/1") = d(arr(i, 5) & "/1") + arr(i, 30)
- d(arr(i, 5) & arr(i, 6) & "/1") = d(arr(i, 5) & arr(i, 6) & "/1") + arr(i, 30)
- arr(i, 45) = IIf(d(arr(i, 5) & "/1") > 0, arr(i, 43), 0)
- arr(i, 46) = IIf(d(arr(i, 5) & arr(i, 6) & "/1") > 0, arr(i, 44), 0)
- Next
- Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
- Set d = Nothing
- End Sub
 代码.rar
|