☰

¿Cómo aleatorizar los valores porcentuales?

tag-icon • tag-icon microsoft-excel vba
¿Cómo aleatorizar los valores porcentuales?

Tengo un problema con VBA Excel.

En la columna F, tengo un número de 57,07%. Esta columna tiene 102 filas. La idea es generar valores aleatorios en porcentaje, pero el promedio total de estos números aleatorios tiene que ser 57,07%

Logré generar números completos aleatorios. Pero cuando se trata de sumar y quitar decimales, por alguna razón no obtengo resultados.

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

Como puede ver en la imagen, obtengo ese .07 en todas las celdas, pero no puedo eliminar ese valor de algunas celdas y agregarlo a otras.

IMG:

¿Algunas ideas?
¿Mi bucle está mal?

Respuesta1

Logré solucionarlo. Si alguien más encuentra el mismo problema, aquí está el código. Lo que hice aquí es que agregué otra variable llamada "xnum2" donde generaría un número decimal aleatorio y luego, para cada bucle, eliminaría ese valor del CELLx.value y lo agregaría a otro CELLy.value, para que el promedio seguiría siendo el mismo.

    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

información relacionada