Генерация случайных чисел, сумма которых должна быть постоянной по VBA - PullRequest
0 голосов
/ 06 февраля 2020

Я не могу решить одну проблему. Я пытаюсь сгенерировать случайные числа с фиксированной общей суммой и без фиксированного периода. Я пытался увеличить среднее значение в процентах до середины периода и уменьшить его до конца периода, но общая сумма меняется. Вот почему я не знаю, как генерировать числа. Требования: Общая сумма должна быть фиксированной. Период может быть изменен. Распределение сгенерированных чисел должно быть увеличено до середины периода и уменьшено до конца периода. Первое сгенерированное случайное число должно быть равно среднему значению (среднее значение = общее число / период) Мой код VBA

Sub Distribution_and_Graph()

Dim Start As Date
Dim EndP As Date
Dim Duration As Integer
Dim NoDays As Integer
Dim manHours As Long
Dim averageManHours As Long
Dim LC As Integer
Dim i As Integer 
Dim percent1 As Integer

On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Distribution").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "Distribution"
Application.DisplayAlerts = True
Set DGSheet = Worksheets("Distribution")


Worksheets("Distribution").Activate

Start = Application.InputBox("Enter your START date of project, ex 01.12.2020 ")
If Start = False Then Exit Sub
EndP = Application.InputBox("Enter you END date of project, ex 01.12.2020 ")
If EndP = False Then Exit Sub
manHours = Application.InputBox("Enter the TOTAL MAN HOURS")
If manHours = False Then Exit Sub

percent1 = Application.InputBox("Enter your starting period's PERCENTAGHE rate distribution , ex 50,65,10 ")
If percent1 = False Then Exit Sub
Duration = -Int(CDbl(Start)) + Int(CDbl(EndP)) + 30 
NoDays = EndP - Start + 1


Range("A1").Value = "Months"
Range("A3").Value = "Total man/hours"
Range("A2").Value = "QTY of workers"
Range("A4").Value = "Ðàñõîäíèêè"

Range("B1").Value = Start
Range("B1").Resize(NoDays).DataSeries Rowcol:=xlRows, Type:=xlChronological, Date:= _
xlMonth, Step:=1, Stop:=EndP, Trend:=False



 LC = Cells(1, Columns.Count).End(xlToLeft).Column

Cells(3, 2).Value = (manHours * 30) / Duration

 For i = 2 To LC * 0.5
 Cells(3, i + 1).Value = Cells(3, i).Value * (1 + percent1 / 100)

  Cells(2, i).Value = Cells(3, i).Value / 330 ' Must be changed
  Cells(4, i).Value = Cells(3, i).Value * 382  'Must be changed
  Cells(2, i).NumberFormat = "#,##0"
  Cells(3, i).NumberFormat = "#,##0"
  Cells(4, i).NumberFormat = "#,##0"
   Next i

   For i = LC * 0.500000000000001 To LC
   Cells(3, i + 1).Value = Cells(3, i).Value * (1 - percent1 / 100)

   Cells(2, i).Value = Cells(3, i).Value / 330 ' Must be changed
   Cells(4, i).Value = Cells(3, i).Value * 382  'Must be changed
   Cells(2, i).NumberFormat = "#,##0"
    Cells(3, i).NumberFormat = "#,##0"
    Cells(4, i).NumberFormat = "#,##0"
   Next i

 End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...