总和值直到达到某个值,然后从下一列开始



我必须总和一些值,直到在Excel VBA中达到完整数字(1.0或2.0或3.0(。

我有合同和以下数据集,因为我只能将"完整合同"视为一个,所以我必须总结它,直到达到此阈值。当它超出该门槛时,可以说我有0.5合同,下个月我获得了0.6,我会产生完整的合同,并将0.1((0.5 0.6(-1(作为下一个月开始的下一个基础。但是,如果我达到了2个以上,则必须在最后一列中获得2个合同。

我了解我的问题

我想到了类似于循环的内容,该循环总和列中的值,如果总和> = 1,则比将" 1"写入下一个列中,并从总和中减去1,如果总和为> =,则继续。2比它将" 2"写入下一列,然后从总和等减去2 ...

Dates   Est. Contracts  Sum of Contracts    Actual Contracts
01.06.2019  0,2               0,2   
01.07.2019  0,3               0,5   
01.08.2019  0,5               1,0                 1
01.09.2019  0,5               0,5   
01.10.2019  0,6               1,1                 1
01.11.2019  0,7               0,8   
01.12.2019  0,9               1,7                 1
01.01.2020  1,2               1,9                 1
01.02.2020  1,5               2,3                 2
01.03.2020  1,7               2,1                 2
01.04.2020  2,0               2,0                 2
01.05.2020  2,2               2,2                 2

您的意思是这样?:

╔═══════╦═══════════════╦═══════════╦══════════════╗
║ dates ║ est contracts ║ sum contr ║ actual contr ║
╠═══════╬═══════════════╬═══════════╬══════════════╣
║       ║ 0.1           ║ 0.1       ║              ║
║       ║ 0.2           ║ 0.3       ║              ║
║       ║ 0.3           ║ 0.6       ║              ║
║       ║ 0.4           ║ 1         ║            1 ║
║       ║ 0.2           ║ 0.2       ║              ║
║       ║ 0.4           ║ 0.6       ║              ║
║       ║ 0.4           ║ 1         ║            1 ║
║       ║ 0.8           ║ 0.8       ║              ║
║       ║ 1.4           ║ 2.2       ║            2 ║
║       ║ 0.9           ║ 1.1       ║            1 ║
║       ║ 2.2           ║ 2.3       ║            2 ║
╚═══════╩═══════════════╩═══════════╩══════════════╝

Option Explicit
Sub WholeContracts()
Dim rng As Range
Dim lastrow As Long
Dim el As Range
Dim sumContr As Double
lastrow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
Set rng = Range("B2", "B" & lastrow)
rng.Select
sumContr = 0
For Each el In rng
    el.Select
    sumContr = el.Value + sumContr
    el.Offset(0, 1).Value = sumContr
    If Int(sumContr) = 1 Then
        el.Offset(0, 2) = 1
        sumContr = sumContr - 1
    ElseIf Int(sumContr) = 2 Then
        el.Offset(0, 2) = 2
        sumContr = sumContr - 2
    ElseIf Int(sumContr) = 3 Then
        el.Offset(0, 2) = 3
        sumContr = sumContr - 3
    End If
Next el
End Sub

最新更新