☰

如何隨機化百分比值？

tag-icon • tag-icon microsoft-excel vba
如何隨機化百分比值？

我在使用 VBA excel 時遇到問題。

在 F 列中，我有一個數字 57.07%。該列有 102 行。這個想法是產生百分比隨機值，但這些隨機數的總平均值必須為 57.07%

我設法產生隨機完整數字。但是，當由於某種原因添加和刪除小數時，我沒有得到任何結果。

Sub RandomiseSum()
    Dim countries As Range, country As Range, pageviews As Range, clicks As Range, impressions As Range, col_f As Range, col_g As Range, col_h As Range, earnings As Range



Dim arr() As Double, i, z, y As Integer

'~~>Count the result of the range of countries
Set countries = Range("B4:B102")
Set pageviews = Range("C4:C102")
Set impressions = Range("D4:D102")
Set clicks = Range("E4:E102")
Set col_f = Range("F4:F102")
Set col_g = Range("G4:G102")
Set col_h = Range("H4:H102")
Set earnings = Range("I4:I102")
ReDim arr(countries.count - 1)
For i = 0 To countries.count - 1
    arr(i) = Rnd
Next i
i = i - 1                                           '~~> Remove 1 from the total cell number in order to put the decimals/diferences in it at the end

'~~> Totals
TotalC = Range("C2").Value
TotalD = Range("D2").Value
TotalE = Range("E2").Value
avg_f = Range("F2").Value
avg_g = Range("G2").Value
avg_h = Range("H2").Value
TotalI = Range("I2").Value


col_h = avg_h
half1 = i / 2
half2 = (i / 2) + 1
z = half2
y = 4
x = 0

Do Until x = half1
    this_nr = "H" & y
    xnum = WorksheetFunction.RandBetween(0, 42) / 100
    Range(this_nr).Value = Range(this_nr).Value - xnum
     
    y = y + 1
    z_nr = "H" & z
    Range(z_nr).Value = Range(z_nr).Value + xnum
    
    z = z + 1
    x = x + 1
Loop
rnr = 0
Do Until rnr = half1
    x12 = WorksheetFunction.RandBetween(4, 102)
    x22 = WorksheetFunction.RandBetween(4, 102)
    x12 = "H" & x12
    x22 = "H" & x22
    x3 = x12
    
    Range(x12).Value = Range(x22).Value
    Range(x22).Value = Range(x3).Value

    rnr = rnr + 1
    Loop
        y = 4
        z = half2
        For x = 0 To x = half1
            this_nr = "H" & y
            z_nr = "H" & z
      
           Range(this_nr).Value = Range(this_nr).Value - 0.3
           Range(z_nr).Value = Range(z_nr).Value + 0.03
            
            z = z + 1
            x = x + 1
         Next x
End Sub

正如您從圖片中看到的那樣，我在所有單元格中都得到了 0.07，但我無法從某些單元格中刪除該值並將其添加到其他單元格中。

圖片：

有任何想法嗎？
我的循環有問題嗎？

答案1

我設法解決了它。如果其他人遇到同樣的問題，這裡是程式碼。我在這裡所做的是添加另一個名為“xnum2”的變量，在其中生成一個隨機十進制數，然後對於每個循環，我將從CELLx.value 中刪除該值並將其添加到另一個CELLy .value 中，以便平均值仍會是相同的。

    col_h = avg_h
    half1 = i / 2
    half2 = (i / 2) + 1
    z = half2
    y = 4
    x = 0
    
    Do Until x = half1
        this_nr = "H" & y
        xnum = WorksheetFunction.RandBetween(0, 42) / 100
        Range(this_nr).Value = Range(this_nr).Value - xnum
        
      xnum2 = WorksheetFunction.RandBetween(0, 9) / 10000
   Range(this_nr).Value = Range(this_nr).Value - xnum2
        
        y = y + 1
        z_nr = "H" & z
        Range(z_nr).Value = Range(z_nr).Value + xnum
      Range(z_nr).Value = Range(z_nr).Value + xnum2
        
        z = z + 1
        x = x + 1
    Loop
    rnr = 0
    Do Until rnr = half1
        x12 = WorksheetFunction.RandBetween(4, 102)
        x22 = WorksheetFunction.RandBetween(4, 102)
        x12 = "H" & x12
        x22 = "H" & x22
        x3 = x12
        
        Range(x12).Value = Range(x22).Value
        Range(x22).Value = Range(x3).Value
    
        rnr = rnr + 1
        Loop

相關內容