编写VB代码

QQ3677344260

tanglf188 发表于 2024-6-14 17:31
需要0的话第三行改为：Sheet1.[A1:A5].Value=0

谢谢！请问如果通过C1单元格的数来约束随机数之和，单元格改为a1到a10，这代码该怎么修改？

micch

1. range("a1:a999").value=0
   
2. range("a1:a" & range("c1").value)=1
   
3. range("b1:b999").formula="=rand()"
   
4. range("a1:b" & 10).sort [b1]

复制代码

不要不停的换规则，       提供一个简单的思路，C1输入几，就是A1:A几输入1，后面都是0，然后B列写=rand(),根据B列排序，就打乱了

QQ3677344260

ynzsvt 发表于 2024-6-14 17:03

你好，发现一个问题，这代码有时要点击好几次按钮才有反应，能优化到点一次反应一次就好了

gwjkkkkk

Option Explicit
Sub test()
    Dim ar, i&, iNum&, t#
    t = Timer
   
    Columns(1).Clear
    iNum = [C1].Value
    If iNum < 0 Or iNum > 10 Then MsgBox "数据错误!": Exit Sub
   
    ar = rndNumIsTotalSum(0, 1, 10, [C1].Value)
   
    ar = Application.Transpose(ar)
    With [A1].Resize(UBound(ar))
        .Interior.Color = xlNone
        .Value = ar
        For i = 1 To UBound(ar)
            If ar(i, 1) = 1 Then .Cells(i, 1).Interior.Color = vbYellow
        Next i
    End With
End Sub
Function rndNumIsTotalSum(ByVal iMinNum&, ByVal iMaxNum&, ByVal iCount&, ByVal iSumNum&)
    Dim ar(), i&, iAverage&, iRnd1&, iRnd2&, iRndNum&, iBal1&, iBal2&

    ReDim ar(1 To iCount)
    iAverage = Int(iSumNum / iCount)
    If iAverage < iMinNum Or iAverage > iMaxNum Then
        For i = 1 To UBound(ar): ar(i) = "无解！": Next
        rndNumIsTotalSum = ar: Exit Function
    End If
    For i = 1 To UBound(ar)
        ar(i) = iAverage
    Next i
    For i = 1 To (iSumNum - iAverage * iCount)
        ar(i) = ar(i) + 1
    Next i
    Randomize
    For i = 1 To iCount
        iRnd1 = Int(iCount * Rnd + 1): iRnd2 = Int(iCount * Rnd + 1)
        iBal2 = iMaxNum - ar(iRnd2): iBal1 = ar(iRnd1) - iMinNum
        If iBal2 < iBal1 Then iRndNum = iBal2 Else iRndNum = iBal1
        iRndNum = Int(Rnd * (iRndNum + 1))
        ar(iRnd1) = ar(iRnd1) - iRndNum
        ar(iRnd2) = ar(iRnd2) + iRndNum
    Next i
   
    rndNumIsTotalSum = ar
End Function

gwjkkkkk

请参考附件。。。

ynzsvt

1. Sub A1A5有条件随机()
   
2. Dim Arr(1 To 5, 1 To 1), i&, S&, Brr, Pd As Boolean
   
3. Randomize Timer
   
4. Brr = [a1:A5]
   
5. Do
   
6.   S = 0
   
7.   For i = 1 To 5
   
8.    Arr(i, 1) = IIf(Rnd() > 0.5, 1, 0)
   
9.    S = S + Arr(i, 1)
   
10.   Next i
    
11.   If S = 3 Then
    
12.    Pd = False
    
13.    For i = 1 To 5
    
14.     If Arr(i, 1) <> Brr(i, 1) Then Pd = True: Exit For
    
15.    Next i
    
16.    If Pd Then [a1:A5] = Arr: Exit Do
    
17.   End If
    
18. Loop
    
19. End Sub

复制代码

QQ3677344260

micch 发表于 2024-6-14 18:49
不要不停的换规则，       提供一个简单的思路，C1输入几，就是A1:A几输入1，后面都是0，然后B列写=rand( ...

好的，谢谢！

QQ3677344260

ynzsvt 发表于 2024-6-14 19:23

很不错！谢谢！

QQ3677344260

gwjkkkkk 发表于 2024-6-14 19:20
请参考附件。。。

收到！谢谢你！

longwin

参与一下：
Sub test()
zh = [C1]  '和值设定
sl = 10   '单元格数量
Range("A1:A" & sl).Value = 0
For i = 1 To zh
    Do
        hh = WorksheetFunction.RandBetween(1, sl)
        If Cells(hh, 1) = 0 Then Exit Do
    Loop
    Cells(hh, 1) = 1
Next
End Sub