☰

백분율 값을 무작위로 추출하는 방법은 무엇입니까?

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

그림에서 볼 수 있듯이 모든 셀에서 .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

관련 정보