Sub 限行列和隨機加牆版()
    Dim nRows As Long, nCols As Long, nLastRow As Long, tmpSum As Long, tmpRow As Long, r As Long, c As Long
    Dim sumRows() As Long, nRowSkipSum() As Long, nColSkipSum() As Long, nColsLast() As Long
    Dim bForceValue() As Boolean
    Dim vArr() As Variant
    Dim fOffset As Single
    vArr 
 
= Sheet1.Range("A2").CurrentRegion.Value '取資料
    nRows = UBound(vArr)
    nCols = UBound(vArr, 2)
    ReDim sumRows(3 To nRows)
    ReDim nRowSkipSum(3 To nRows)
    ReDim nColsLast(3 To nRows)
    ReDim nColSkipSum(2 To nCols - 1)
    ReDim nRowsLast(2 To nCols - 1)
    ReDim bForceValue(3 To nRows, 2
 
 To nCols)
    With Sheet1.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
    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! '隨機值浮動百分比
    fOffset = 0.08! '隨機值浮動百分比
    '    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
    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
    If 二維陣列含負數(vArr) = False Then
        Call 限行列和隨機加牆版
    Else
        Sheet1.Range("A1").Resize(UBound(vArr), UBound(vArr, 2)).Value = vArr
    End If
End Sub

Function 二維陣列含負數(ar)
    flag = True
    For x = 3 To UBound(ar)
        For y = 2 To UBound(ar, 2)
            If ar(x, y) < 0 Then
                flag = False
            End If
        Next
    Next
    二維陣列含負數 = flag
End Function


Function 檢查二維陣列是否合法(vArr)
    '    vArr = Sheet2.Range("A2").CurrentRegion.Value '取資料
    If 二維陣列含負數(vArr) = False Then
        MsgBox "隨機數不合理,請重試一次!"
    Else
        MsgBox "隨機數取值合理,請執行主程式!"
    End If
End Function

Sub 單獨檢查二維陣列是否包含負數()
    vArr = Sheet1.Range("A2").CurrentRegion.Value '取資料
    If 二維陣列含負數(vArr) = False Then
        MsgBox "隨機數不合理,請重試一次!"
    End If
End Sub