☰

Wie werden die Prozentwerte zufällig angeordnet?

tag-icon • tag-icon microsoft-excel vba
Wie werden die Prozentwerte zufällig angeordnet?

Ich habe ein Problem mit VBA Excel.

In Spalte F habe ich eine Zahl von 57,07 %. Diese Spalte hat 102 Zeilen. Die Idee ist, zufällige Werte in Prozent zu generieren, aber der Gesamtdurchschnitt dieser Zufallszahlen muss 57,07 % betragen

Ich habe es geschafft, zufällige ganze Zahlen zu generieren. Aber beim Hinzufügen und Entfernen von Dezimalstellen erhalte ich aus irgendeinem Grund keine Ergebnisse.

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

Wie Sie auf dem Bild sehen können, erhalte ich in allen Zellen den Wert 0,07, aber ich kann den Wert aus einigen Zellen nicht entfernen und zu anderen hinzufügen.

Bild:

Irgendwelche Ideen?
Ist meine Schleife falsch?

Antwort1

Ich habe es geschafft, es zu lösen. Falls jemand anderes auf das gleiche Problem stößt, hier ist der Code. Ich habe hier eine weitere Variable namens „xnum2“ hinzugefügt, in der ich eine zufällige Dezimalzahl generieren würde. Dann würde ich für jede Schleife diesen Wert aus dem CELLx.value entfernen und ihn einem anderen CELLy.value hinzufügen, sodass der Durchschnitt immer noch derselbe wäre.

    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

verwandte Informationen