能用函数根据数值随机分配数字，使和等与左边和上边数值

函数实现不了，函数是被动式

传入二维数组， 下标为1的为和
1、校验， 竖列和与横列和是否均等于 1，1 ，如果不，报错。
2、查找 竖列和横列 最小值，从第一个单元格开始随机数，除最后一个格子是 范围是 1 至 总和 减去已产生的结果的格子和 再减去剩余格子数，最后一个格子为 总和 减去已产生的格子和
3、重复第二步
4、最后返回这个二维数组。

没环境了，不写代码了。

理解不来。如果能上代码就好了!万分感谢。

Excel 2021 调试通过

Option Explicit

 
Sub aa()

Dim b(6)
Dim i, j, m, n, t

Randomize

'读和值及求和
m = 0
n = 0
b(0) = Cells(1, 1)
For i = 2 To 4
    b(i - 1) = Cells(1, i)
    m = m + b(i - 1)
    b(i + 2) = Cells(i, 1)
    n = n + b(i + 2)
Next i

'校验
If m <> b(0) Or n <> b(0) Then
    MsgBox "和值校验失败", vbCritical, "错误"
    Exit Sub
End If

'循环，最后一次不用管

For t = 1 To 5
    '查询最小值
    m = 0
    For i = 1 To 6
        If b(m) > b(i) Then
            m = i
        End If
    Next i
    '开始填值
    If m <= 3 Then          '区分一下。算法是一样的，但引用的单元格方向有差异，不愿写子函数了
        '填第一个格子
        If Cells(2, m + 1) = "" Then
            If Cells(3, m + 1) = "" Then
                If Cells(4, m + 1) = "" Then
                    Cells(2, m + 1) = Int(Rnd() * (Cells(1, m + 1) - 3) + 1)
                Else
                    Cells(2, m + 1) = Int(Rnd() * (Cells(1, m + 1) - Cells(4, m + 1) - 2) + 1)
                End If
            Else
                If Cells(4, m + 1) = "" Then
                    Cells(2, m + 1) = Int(Rnd() * (Cells(1, m + 1) - Cells(3, m + 1) - 2) + 1)
                Else
                    Cells(2, m + 1) = Cells(1, m + 1) - Cells(3, m + 1) - Cells(4, m + 1)
                End If
            End If
        End If
        
        '填第二个格子
        If Cells(3, m + 1) = "" Then
            If Cells(4#, m + 1) = "" Then
                Cells(3, m + 1) = Int(Rnd() * (Cells(1, m + 1) - Cells(2, m + 1) - 1) + 1)
            Else
                Cells(3, m + 1) = Cells(1, m + 1) - Cells(2, m + 1) - Cells(4, m + 1)
            End If
        End If
        
        '填第三个格子
        If Cells(4, m + 1) = "" Then
            Cells(4, m + 1) = Cells(1, m + 1) - Cells(2, m + 1) - Cells(3, m + 1)
        End If

    Else
    
         '填第一个格子
        If Cells(m - 2, 2) = "" Then
            If Cells(m - 2, 3) = "" Then
                If Cells(m - 2, 4) = "" Then
                    Cells(m - 2, 2) = Int(Rnd() * (Cells(m - 2, 1) - 3) + 1)
                Else
                    Cells(m - 2, 2) = Int(Rnd() * (Cells(m - 2, 1) - Cells(m - 2, 4) - 2) + 1)
                End If
            Else
                If Cells(m - 2, 4) = "" Then
                    Cells(m - 2, 2) = Int(Rnd() * (Cells(m - 2, 1) - Cells(m - 2, 3) - 2) + 1)
                Else
                    Cells(m - 2, 2) = Cells(m - 2, 1) - Cells(m - 2, 3) - Cells(m - 2, 4)
                End If
            End If
        End If
        
        '填第二个格子
        If Cells(m - 2, 3) = "" Then
            If Cells(m - 2, 4) = "" Then
                Cells(m - 2, 3) = Int(Rnd() * (Cells(m - 2, 1) - Cells(m - 2, 2) - 1) + 1)
            Else
                Cells(m - 2, 3) = Cells(m - 2, 1) - Cells(m - 2, 2) - Cells(m - 2, 4)
            End If
        End If
        
        '填第三个格子
        If Cells(m - 2, 4) = "" Then
            Cells(m - 2, 4) = Cells(m - 2, 1) - Cells(m - 2, 2) - Cells(m - 2, 3)
        End If
    
    End If
    b(m) = b(0)     '不让下次查找到
Next t
    MsgBox "填充完成", vbInformation, "完成"
End Sub

[此贴子已经被作者于2023-6-20 16:45编辑过]

谢谢大佬，能否补完子过程呢？感谢🙏

'区分一下。算法是一样的，但引用的单元格方向有差异，不愿写子函数了

是这句吗？
这句意思是后面这二大段代码可以简化为一个子函数来实现，但不愿写了，就直接写成二大段代码了。

现在发出来的代码是完整的代码，只是填充部分有点重复而以，但执行效率这种重复的代码反而更高一点。

我这代码里的注释已够多了

-----------------
'读和值及求和
m = 0
n = 0
b(0) = Cells(1, 1)
For i = 2 To 4
    b(i - 1) = Cells(1, i)
    m = m + b(i - 1)
    b(i + 2) = Cells(i, 1)
    n = n + b(i + 2)
Next i

b数组，
0 总和，对应 1，1 ，只用于校验
1-3 ，横列和值
4-6，竖列和值
m,横列求和
n,竖列求和
-----------------------
        '填第一个格子
        If Cells(2, m + 1) = "" Then                 如果第一个格子是空，则填格子
            If Cells(3, m + 1) = "" Then             如果第二个格子为空，则继续
                If Cells(4, m + 1) = "" Then         如果第三个格子为空，按三个格子都为空的方法随机产生数据填充，范围是 和值-格子数，产生随机数，取整后+1，确保不能为0
                    Cells(2, m + 1) = Int(Rnd() * (Cells(1, m + 1) - 3) + 1)
                Else            如果第三个格子不为空，按二个格子为空的方法随机产生数据填充，算法同上。
                    Cells(2, m + 1) = Int(Rnd() * (Cells(1, m + 1) - Cells(4, m + 1) - 2) + 1)
                End If
            Else            如果第二个格子不为空，
                If Cells(4, m + 1) = "" Then     如果第三个格子为空，那就按二个格子为空（1 和 3 为空）进行填数据
                    Cells(2, m + 1) = Int(Rnd() * (Cells(1, m + 1) - Cells(3, m + 1) - 2) + 1)
                Else                如果第三个格子不空，按一格子为空 直接计算进行填数据
                    Cells(2, m + 1) = Cells(1, m + 1) - Cells(3, m + 1) - Cells(4, m + 1)
                End If
            End If
        End If
填写第二个格子时，已填好了第一个格子，不管是不是本次填的，都可以确定第一个格子不为空，
所以第二个格子，只有三种情况，一是这个格子已填过，不管一，二是第三个格子为空，按二格填，三是第三个格子不为空，按一格填数据

填写第三格子时，同理，已搞定了前面二个格子，所有只有二种情况，一是这个格子已填过，二是按一格算法填数据
--------------------
'循环，最后一次不用管
For t = 1 To 5
最佳的情况是 填三个横列 或三个竖列就可以完成。
最差的情况是，填了二个横列和二个竖列，然后剩下这 横列和竖列没有叉的那个格子没填，这个格子在 最大值和第二大值关叉点，所以可以少一次循环。
--------------
    b(m) = b(0)     '不让下次查找到
让最小值变成总和值，也就是超过了最大值，就不会在后面查找最小值 中被查找到。
--------------
    '查询最小值
    m = 0
    For i = 1 To 6
        If b(m) > b(i) Then
            m = i
        End If
    Next i
这里也是，先给一个比最大值 还要大的数，然后 搜索 更小的值，保存下标


 

收到的鲜花

• 约定的童话 于 2023-06-24 10:02 送鲜花  1朵  
• VB白白 于 2023-06-27 16:50 送鲜花  1朵