[已解决]随机数求和

HNZZHGY

设想：

      1、在A列的空格填上最大值为2.0最小值为-1.5之间的随机数后求和X

     2、用要求等于的值减去获得的和X后除以空格数得到一个值Y

       3、A列两个相邻之间的随机数加Y值，并放在B列对应的单元格并求得和Z

       4、用要求等于的值减去Z，并放在要求等于的值对应B列的单元格

        5、查询B列数值的绝对值，若有数值大于2.0，则重新第一步开始。直至B列数值的绝对值没有大于2.0结束.

最佳答案

月排行榜 / 总排行榜

grf1973

2016-10-28 11:12

1. Sub tt()
   
2.     arr = Range("a1:a" & [a65536].End(3).Row)
   
3.     r1 = 1
   
4.     For i = 2 To UBound(arr)
   
5.         If Len(arr(i, 1)) > 0 Then
   
6.             xsum = arr(i, 1)
   
7.             r2 = i
   
8. 100:        s = 0
   
9.             For ii = r1 To r2 - 1
   
10.                 x = Rnd * 3.5 - 1.5
    
11.                 arr(ii, 1) = x
    
12.                 s = s + x
    
13.             Next
    
14.             p = xsum - s: arr(ii, 1) = p
    
15.             If p > 2 Or p < -1.5 Then GoTo 100
    
16.             r1 = r2 + 1
    
17.         End If
    
18.     Next
    
19.     [b1].Resize(UBound(arr)) = arr
    
20. End Sub
    

复制代码

跳转到最佳答案楼层

HNZZHGY

顶一下，别沉下去了！

HNZZHGY

再顶，等待高手出现

HNZZHGY

网上找到了与要求大部分相同的，不知如何修改才能达到我的效果，请高出招，谢谢了！

grf1973

仅以11个数生成12.2为例。其他都一样操作的。

1. Sub tt()
   
2.     Dim arr(1 To 11, 1 To 1)
   
3. 100:    s = 0
   
4.     For i = 1 To 10
   
5.         x = Rnd * 3.5 - 1.5
   
6.         arr(i, 1) = x
   
7.         s = s + x
   
8.     Next
   
9.     p = 12.2 - s: arr(i, 1) = p
   
10.     If p > 2 Or p < -1.5 Then GoTo 100
    
11.     [c7].Resize(11) = arr
    
12. End Sub
    

复制代码

grf1973

全代码。

1. Sub tt()
   
2.     arr = Range("a1:a" & [a65536].End(3).Row)
   
3.     r1 = 1
   
4.     For i = 2 To UBound(arr)
   
5.         If Len(arr(i, 1)) > 0 Then
   
6.             xsum = arr(i, 1)
   
7.             r2 = i
   
8.             If r2 - r1 = 1 Then
   
9.                 arr(r1, 1) = xsum
   
10.             Else
    
11. 100:                s = 0
    
12.                 For ii = r1 To r2 - 2
    
13.                     x = Rnd * 3.5 - 1.5
    
14.                     arr(ii, 1) = x
    
15.                     s = s + x
    
16.                 Next
    
17.                 p = xsum - s: arr(ii, 1) = p
    
18.                 If p > 2 Or p < -1.5 Then GoTo 100
    
19.             End If
    
20.             r1 = r2 + 1
    
21.         End If
    
22.     Next
    
23.     [a1].Resize(UBound(arr)) = arr
    
24. End Sub
    

复制代码

grf1973

原数据无解。因为3 4 5 行三个数加起来要为8.3，显然每个数-1.5--2是得不出来的。

HNZZHGY

模拟件的确由于我考虑不周产生了3 4 5 行的错误,谢谢grf1973,现我还有一个问题:

       能不能修改成如左边的格式，每个增加一个数和还是不变，12.2，原来为15个数，现修改为16个数，它们的和还是12.2，16.9，原来为11个数，现修改为12个数，它们的和还是16.9，其他一样，并把它们放在B列，谢谢！

HNZZHGY

能不能修改成如左边的格式，每个增加一个数和还是不变，12.2，原来为15个数，现修改为16个数，它们的和还是12.2，16.9，原来为11个数，现修改为12个数，它们的和还是16.9，其他一样，并把它们放在B列，谢谢！
0                       
0                       
        0.695545286               
        1.872618079               
        1.396850139               
        0.439052641               
        0.623999089               
        -0.834252119               
        1.656987101               
        -0.384937346               
        0.601706356               
        0.590414166               
        1.184623986               
        1.002244771               
        0.904881686               
        1.161723137               
        1.288543028               
12.2        增加一个数与上面15个数和等于12.2               
        1.734127134               
        0.889685035               
        1.447211772               
        1.983280241               
        1.405378789               
        1.579421282               
        1.142529398               
        1.978748262               
        1.549712032               
        1.629209638               
        1.560696417               
16.9        增加一个数与上面11个数和等于16.9               
        0.48431924               
        1.713754714               
        1.188564748               
        1.80603528               
        1.734171778               
        -0.110632002               
        1.7612122               
        1.664631009               
        1.803770334               
        1.619415104               
        1.334757596               
15        增加一个数与上面11个数和等于15               
                       
                       
                       

grf1973

1. Sub tt()
   
2.     arr = Range("a1:a" & [a65536].End(3).Row)
   
3.     r1 = 1
   
4.     For i = 2 To UBound(arr)
   
5.         If Len(arr(i, 1)) > 0 Then
   
6.             xsum = arr(i, 1)
   
7.             r2 = i
   
8. 100:        s = 0
   
9.             For ii = r1 To r2 - 1
   
10.                 x = Rnd * 3.5 - 1.5
    
11.                 arr(ii, 1) = x
    
12.                 s = s + x
    
13.             Next
    
14.             p = xsum - s: arr(ii, 1) = p
    
15.             If p > 2 Or p < -1.5 Then GoTo 100
    
16.             r1 = r2 + 1
    
17.         End If
    
18.     Next
    
19.     [b1].Resize(UBound(arr)) = arr
    
20. End Sub
    

复制代码