|
本帖最后由 一指禅62 于 2020-3-6 23:18 编辑
- Sub 计算仓储费()
- Const Tmax = 7 - 1 '超过7天开始计费
- Dim t As Date, ds, i&, a(), x%
- Dim d As Object, s$, m%, n%
- t = Sheet2.Range("B2").Value
- ds = Sheet1.Range("A1").CurrentRegion
- Set d = CreateObject("Scripting.Dictionary")
- For i = 2 To UBound(ds)
- If ds(i, 8) <> "" Then '批次号
- s = Trim(ds(i, 2)) & "|" & Trim(ds(i, 8)) '品名+批次
- If Not d.Exists(s) Then
- n = n + 1: ReDim Preserve a(1 To 3, 1 To n)
- d(s) = n
- a(1, n) = ds(i, 1) + Tmax '初始取费日期
- a(2, n) = ds(i, 5)
- Else
- If ds(i, 1) < t Then '当前计费期间内
- m = d.Item(s)
- x = DateDiff("d", a(1, m), ds(i, 1)) - 1 ' '计费天数
- If x > 0 Then
- a(1, m) = ds(i, 1) - 1 '更新计费日期
- a(3, m) = a(3, m) + a(2, m) * x * 0.01
- 'Debug.Print s, x
- End If
- a(2, m) = a(2, m) - ds(i, 6) '结存数量
-
- End If
- End If
- End If
- Next
-
- Sheet2.Range("A4:C10000").ClearContents
- If n = 0 Then Exit Sub
- Dim k, Sm
- ReDim temp(1 To d.Count)
- n = 0
- For Each k In d.keys
- n = n + 1
- m = d.Item(k)
- x = DateDiff("d", a(1, m), t) '计费天数
- 'Debug.Print k, x
- temp(n) = a(3, m) + IIf(x > 0, a(2, m) * x * 0.01, 0)
- Sm = Sm + temp(n)
- Next
- With Sheet2
- .Range("A4").Resize(n, 2) = WorksheetFunction.Transpose(d.keys)
- .Range("A:A").Replace "|*", ""
- .Range("B:B").Replace "*|", ""
- .Range("C4").Resize(n, 1) = WorksheetFunction.Transpose(temp)
- End With
- With Sheet2.Range("C10000").End(3)
- .Offset(1, -2) = "合计"
- .Offset(1, 0) = Sm
- End With
- End Sub
复制代码
|
|