随机数据生成工具

阿光IsGodLike

【需求】

    人员min已有多个数据总值，现在需要根据已有的值将其随机拆分至不同的产品/部门/品牌等维度，数据值类型可能包含小数点/文本/负数/整数。
【分析】
    1.如果直接用随机区间去截取数据会产生一个问题，即随机的数据产生会集中在前面的几列，而后续的列的值基本全部变为0,有自己写过的人有亲身体会。所以为了解决这个问题，需要根据拆分的组数对每个随机数的上限进行二次约束。
    2.负数进行随机拆解的问题，如果用randbettwen方法需要注意传入的参数始终保持左小又大；
    3.小数点的问题，可以先对它进行放大后再操作
    4.解决分组数量动态变化的问题，起一个参数表，读取后作为分组数量即可
【代码】
    1.主程序
Sub genRandomNum()
    t_1 = Timer
    arr = Sheets("随机分配").[a1].CurrentRegion
    ars = Sheets("参数设置").[a1].CurrentRegion
    If UBound(arr, 2) > 1 Then
        Sheets("随机分配").Range(Sheets("随机分配").Cells(1, 2), Sheets("随机分配").Cells(UBound(arr), UBound(arr, 2))).ClearContents
    End If
    '解决生成的随机数主要集中在前面的几个维度的问题
    If UBound(ars) <= 3 Then
        k = 1
    Else
        If UBound(ars) <= 6 Then
            k = 0.4
        Else
            k = 2 / (UBound(ars) - 2)
        End If
    End If
    Dim rData
    ReDim rData(1 To UBound(arr), 1 To UBound(ars) - 1)
    For j = 2 To UBound(ars)
        rData(1, j - 1) = ars(j, 1)
    Next j
    For i = 2 To UBound(arr)
        If IsNumeric(arr(i, 1)) = True Then
            If arr(i, 1) = 0 Then
                For j = 2 To UBound(ars)
                    rData(i, j - 1) = 0
                Next j
            Else
                If arr(i, 1) > 0 Then
                    syn = 1
                Else
                    arr(i, 1) = -arr(i, 1)
                    syn = -1
                End If
                rateVal = 10 ^ handleDigitalNum(arr(i, 1))
                arr(i, 1) = arr(i, 1) * rateVal
                t = arr(i, 1)
                m = 0
                For j = 2 To UBound(ars) - 1
                    rData(i, j - 1) = arr(i, 1)
                    While rData(i, j - 1) / arr(i, 1) > k
                        rData(i, j - 1) = WorksheetFunction.RandBetween(0, arr(i, 1) - m)
                    Wend
                    m = m + rData(i, j - 1)
                    t = t - m
                Next j
                rData(i, UBound(ars) - 1) = (arr(i, 1) - m)
                For j = 2 To UBound(ars)
                    rData(i, j - 1) = rData(i, j - 1) * syn / rateVal
                Next j
            End If
        On Error Resume Next
        End If
    Next i
    Sheets("随机分配").Cells(1, 2).Resize(UBound(arr), UBound(ars) - 1) = rData
    t_2 = Timer
    MsgBox "运行成功！RunTime:" & Round(t_2 - t_1, 2) & "s." & vbCrLf & "Program Designed By Apollo_Chen On 2022/10/29." & vbCrLf & "For MinMinMin Only!", vbOKOnly, "Lovely.Min"
End Sub

    2.处理小数点的函数

Function handleDigitalNum(num)  '解决小数点的问题
    If InStr(1, Str(num), ".") > 0 Then
        arrNum = Split(Str(num), ".")
        n = Len(arrNum(1))
    Else
    n = 0
    End If
    handleDigitalNum = n
End Function


【运行结果示例】

示例

jiangxiaoyun

不错。这种可以用规划求解来做的。相对来说简单，录制个宏就行。

micch

看了眼花缭乱的，功能是把一个数字拆为10个随机数字，使得和值为源数字吧？为什么直接随机会集中在前面，那是什么写法。   最容易理解的逻辑不是直接随机10个数然后插值法换算一下吗

阿光IsGodLike

micch 发表于 2022-11-9 23:00
看了眼花缭乱的，功能是把一个数字拆为10个随机数字，使得和值为源数字吧？为什么直接随机会集中在前面，那 ...

整数型数据要求分解为整数，线性插值解决的了？

jz_l

准提部林

既是隨機,
以55分配10個, 有無可能第一個就是46, 剩下的都只能分配1

阿光IsGodLike

准提部林 发表于 2022-11-10 13:25
既是隨機,
以55分配10個, 有無可能第一個就是46, 剩下的都只能分配1

也可以9和8个0哈

阿光IsGodLike

jz_l 发表于 2022-11-10 10:44

我知道公式可以解决，我这个程序是设计给别人用的，不是每次都分成10组，所以要综合考虑批量和动态的问题

jz_l

阿光IsGodLike 发表于 2022-11-10 14:01
我知道公式可以解决，我这个程序是设计给别人用的，不是每次都分成10组，所以要综合考虑批量和动态的问题 ...

公式演示是对3楼、4楼的回复

准提部林

這兩個參數, 可用一行即可
小數點位數 V=LEN(SPLIT(數字 & ".", ".")(1))
正負值 P=1+(數字<0)*2....或用IIF