Question

我想使用几何分布在一些不同的列上传播一个数字。

E.g。我有100美元，需要在10周内分配。使用几何分布，最高金额将在第1周分配，第2周分配较低，......和第10周最低分配，所有周的总和再次为100美元。

我有几个要分发的值，而且＃列有所不同，所以我希望能够使用标准化的几何分布模式。

谁能在上面的例子中提供适当的功能？

由于 Ñ

Answer 1

关于你在过去5天内没有尝试任何事情的事实，这就是我想出的：

Option Explicit

Public Sub GeometricCraziness(rngRange As Range, Optional lngAccuracy As Long = 16)

    Dim rngCell         As Range
    Dim rngLast         As Range

    Dim dblTotal        As Double
    Dim dblLeft         As Double
    Dim dblSumArray     As Double

    Dim lngCounter      As Long
    Dim varArray        As Variant

    dblTotal = rngRange(1, 1)
    dblLeft = dblTotal
    lngCounter = 0

    ReDim varArray(rngRange.Count - 1)

    For Each rngCell In rngRange
        If lngCounter Then
            varArray(lngCounter) = 1 / (2 ^ lngCounter)
            rngCell = Round(dblTotal / (2 ^ lngCounter), lngAccuracy)
            dblLeft = dblLeft - rngCell.value
            Set rngLast = rngCell
        End If
        lngCounter = lngCounter + 1
    Next rngCell

    For lngCounter = LBound(varArray) To UBound(varArray)
        dblSumArray = dblSumArray + varArray(lngCounter)
    Next lngCounter

    For lngCounter = 1 To UBound(varArray)
        varArray(lngCounter) = Round(varArray(lngCounter) / dblSumArray, lngAccuracy)
    Next lngCounter

    lngCounter = 0

    For Each rngCell In rngRange
        If lngCounter Then
            rngCell = Round(rngCell + rngLast * varArray(lngCounter), lngAccuracy)
        End If
        lngCounter = lngCounter + 1
    Next rngCell

End Sub

你称之为call GeometricCraziness(selection) 如果您在选择的第一个单元格中有555，则可以得到如下内容：

它不是最好的选择，但是到目前为止我能想到的最好。它的工作原理！：）

逻辑如下：每个下一个数字比第一个循环的前一个数字至少少50％，具有以下公式：

?1/2^n

n= 1
1/2^n = 0,5 

n= 2
1/2^n = 0,25

n= 3
1/2^n = 0,125

然后，我们使用相同的公式在第二个循环中重新分配其余部分。准确度很高（如16），我们得到了不错的价值。

使用Excel中的几何分布在列上传播数字

1 个答案: