限行列和随机

Sub 限行列和随机()
    Dim vArr() As Variant
    vArr = Range("A2").CurrentRegion.Value
    rndArrLmtSumLng2D vArr
    Range("A1").Resize(UBound(vArr), UBound(vArr, 2)).Value = vArr
End Sub

Private Sub rndArrLmtSumLng2D(vArr() As Variant, Optional ByVal fOffset As Single = 0.05!)
    '产生行列均限和的随机数，fOffset可指定值随机偏差范围百分比
    Dim sumCols As Long, sumRows As Long, tmpSum As Long, tmpCol As Long
    Dim nRows As Long, nCols As Long, nLastCol As Long, nLastRow As Long, r As Long, c As Long
    nRows = UBound(vArr)
    nCols = UBound(vArr, 2)
    For c = 2 To nCols - 1
        sumCols = sumCols + vArr(2, c) '所有列限制之和
        If vArr(2, c) <> 0 Then nLastCol = c '最后1个限制和非0的列
    Next
    For r = 3 To nRows
        sumRows = sumRows + vArr(r, nCols) '所有行限制之和
        If vArr(r, nCols) <> 0 Then nLastRow = r '最后1个限制和非0的行
    Next
    If sumCols <> sumRows Then Exit Sub
    fOffset = Abs(fOffset)
    Randomize
    For c = 2 To nLastCol - 1
        tmpSum = 0
        tmpCol = vArr(2, c) '该列和
        For r = 3 To nLastRow - 1
            vArr(r, c) = Int(tmpCol / sumRows * vArr(r, nCols) * (1! + Rnd * fOffset * 2 - fOffset))
            tmpSum = tmpSum + vArr(r, c)
        Next
        vArr(nLastRow, c) = tmpCol - tmpSum '最后1行剩余值
    Next
    For r = 3 To nLastRow
        tmpSum = 0
        For c = 2 To nLastCol - 1
            tmpSum = tmpSum + vArr(r, c)
        Next
        vArr(r, nLastCol) = vArr(r, nCols) - tmpSum '最后1列剩余值
    Next
    If nLastCol < nCols - 1 Then
        For c = nLastCol + 1 To nCols - 1
            For r = 3 To nRows
                vArr(r, c) = 0
            Next
        Next
    End If
    If nLastRow < nRows Then
        For r = nLastRow + 1 To nRows
            For c = 2 To nCols - 1
                vArr(r, c) = 0
            Next
        Next
    End If
End Sub