Question

我必须对一些值求和，直到在Excel VBA中达到整数（1.0或2.0或3.0）为止。

我有合同和以下数据集，因为我只能简单地将一个“完整合同”算作一个合同，所以我必须对其进行累加直到达到此阈值。当其超过该阈值时，可以说我有0.5张合约，下个月我得到0.6张合约，我将生成一份完整的合约，并以0.1（（0.5 + 0.6）-1）为下一个基数，以开始下个月的总和。但是，如果我的数量超过2，则必须在最后一列中获得2张合约。

我了解我的问题

我想到了类似For循环的事情，即对列中的值求和，如果总和> = 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

Answer 1

您的意思是这样的吗？：

╔═══════╦═══════════════╦═══════════╦══════════════╗
║ 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

求和，直到达到某个值，然后从下一列开始

1 个答案: