限行列和随机加墙版_过程拆解为若干函数

Public nRows As Long, nCols As Long, nLastRow As Long, tmpSum As Long, tmpRow As Long, r As Long, c As Long
Public sumRows() As Long, nRowSkipSum() As Long, nColSkipSum() As Long, nColsLast() As Long
Public bForceValue() As Boolean
Public vArr() As Variant
Public fOffset As Single

Sub 变量初始化()
    tmpSum = 0
    tmpRow = 0
    Erase vArr
    With Sheet3
        vArr = .Range("A2").CurrentRegion.Value '取数据
        nRows = UBound(vArr)
        nCols = UBound(vArr, 2)
        ReDim sumRows(3 To nRows) '以第2行为基数,计算每行的和值(不含黄色的0)
        ReDim nRowSkipSum(3 To nRows)
        ReDim nColsLast(3 To nRows) '每行最后1个列限制和非0的非固定值的列号
        ReDim nColSkipSum(2 To nCols - 1)
        ReDim nRowsLast(2 To nCols - 1)
        ReDim bForceValue(3 To nRows, 2 To nCols) '墙壁标记容器
    End With
End Sub

Sub 以第2行为基数计算每行的和值不含黄色的零()
    With Sheet3
        With .Range("A1")
            For c = 2 To nCols - 1
                For r = 3 To nRows
                    If .Offset(r - 1, c - 1).Interior.Color = vbYellow Then '背景颜色为黄色的单元格固定原值不变(跳过)
                        bForceValue(r, c) = True
                        bForceValue(r, nCols) = True
                        nRowSkipSum(r) = nRowSkipSum(r) + vArr(r, c) '每行跳过值之和
                        nColSkipSum(c) = nColSkipSum(c) + vArr(r, c) '每列跳过值之和
                    Else
                        sumRows(r) = sumRows(r) + vArr(2, c) '每行限制之和
                        If vArr(2, c) <> 0 Then nColsLast(r) = c '每行最后1个列限制和非0的非固定值的列号
                    End If
                Next
            Next
        End With
    End With
End Sub
Sub 计算行列限制和值()
    For c = 2 To nCols - 1
        tmpSum = tmpSum + vArr(2, c)
    Next
    For r = 3 To nRows
        tmpRow = tmpRow + vArr(r, nCols)
        If vArr(r, nCols) <> 0 And bForceValue(r, nCols) = False Then nLastRow = r
    Next
    If tmpRow <> tmpSum Then MsgBox "行与列限制之和不相等！": Exit Sub
    If nLastRow < 3 Then MsgBox "至少要有一行无任何固定值！": Exit Sub
    '    fOffset = 0.05! '随机值浮动百分比
End Sub
Sub 逐行生成随机数()
    fOffset = 0.015! '随机值浮动百分比
    Randomize
    For r = 3 To nRows
        If r <> nLastRow Then
            tmpSum = 0
            tmpRow = vArr(r, nCols) - nRowSkipSum(r) '该行剩余可随机值之和
            For c = 2 To nCols - 1
                If c <> nColsLast(r) And bForceValue(r, c) = False Then
                    vArr(r, c) = Int(tmpRow / sumRows(r) * vArr(2, c) * (1! + Rnd * fOffset * 2 - fOffset))
                    tmpSum = tmpSum + vArr(r, c)
                End If
            Next
            vArr(r, nColsLast(r)) = tmpRow - tmpSum '该行剩余列的值
        End If
    Next
End Sub
Sub main限行列和随机加墙版()
    Call 变量初始化
    Call 以第2行为基数计算每行的和值不含黄色的零
    Call 计算行列限制和值
    Call 逐行生成随机数
    Call 逐列生成随机数
    Call 结果输出
End Sub
Sub 逐列生成随机数()
    For c = 2 To nCols - 1
        tmpSum = 0
        For r = 3 To nRows
            If r <> nLastRow And bForceValue(r, c) = False Then tmpSum = tmpSum + vArr(r, c)
        Next
        vArr(nLastRow, c) = vArr(2, c) - nColSkipSum(c) - tmpSum '剩余列的剩余值
    Next
End Sub
Sub 结果输出()
    With Sheet3
        .Range("A1").Resize(UBound(vArr), UBound(vArr, 2)).Value = vArr
    End With
End Sub