PDA

View Full Version : Sleeper: Need some help with arrays and loops



Thymen123
05-24-2023, 01:47 PM
So, I've got most things working and while my code is highly inefficient, that is not my concern at the moment. I'm quite new to this vba stuff and need it for some school project.
Everything works as it should till the red dotted line. I can't do what I want to after that. I want to calculate the optimal reward. So basically, it should calculate an optimal reward which has a fixed number of NrDoctorsPermanent for every hour n (but it can be any number), because they work in shifts. The code now kind of recalculates a new number every hour, but that is not possible in my case. Hourly staff can also be hired (NrDoctorsHourly) and the two together should produce an optimal outcome. Determining the optimal amount of permanent and hourly staff seperately isn't hard, but I cannot combine this. It is probably easy to fix, but how do I do it? Thanks for your help already!
The code look as follows:


Option Explicit

Dim n As Integer
Dim x As Integer
Dim MeanNrPatients() As Integer
Dim NrDoctorsHourly As Integer
Dim NrDoctorsPermanent As Integer
Dim NrInWaitingRoom() As Integer
Dim Reward() As Double
Dim Shift1() As Double
Dim Shift2() As Double
Dim Shift3() As Double
Dim Optimalshift1 As Double
Dim Optimalshift2 As Double
Dim Optimalshift3 As Double
Dim Optimalreward() As Double
Dim Optimalhour() As Double


Sub Case_3_New()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ReDim MeanNrPatients(0 To 21) As Integer
ReDim Reward(0 To 21, 0 To 120, 0 To 120) As Double
ReDim Shift1(0 To 121)
ReDim Shift2(0 To 121)
ReDim Shift3(0 To 121)
ReDim Optimalreward(n To 21, 0 To 120)
ReDim NrInWaitingRoom(0 To 50) As Integer
ReDim Optimalhour(0 To 21, 0 To 120) As Double
For NrDoctorsPermanent = 0 To 120
Optimalreward(21, NrDoctorsPermanent) = 0
Next NrDoctorsPermanent
MeanNrPatients(0) = 0
MeanNrPatients(1) = 69
MeanNrPatients(2) = 71
MeanNrPatients(3) = 72
MeanNrPatients(4) = 73
MeanNrPatients(5) = 154
MeanNrPatients(6) = 146
MeanNrPatients(7) = 164
MeanNrPatients(8) = 155
MeanNrPatients(9) = 146
MeanNrPatients(10) = 179
MeanNrPatients(11) = 175
MeanNrPatients(12) = 173
MeanNrPatients(13) = 170
MeanNrPatients(14) = 159
MeanNrPatients(15) = 107
MeanNrPatients(16) = 94
MeanNrPatients(17) = 94
MeanNrPatients(18) = 91
MeanNrPatients(19) = 81
MeanNrPatients(20) = 53
MeanNrPatients(21) = 0
'calculate all possible rewards for every hour
For NrDoctorsPermanent = 0 To 120
For NrDoctorsHourly = 0 To 120 - NrDoctorsPermanent
For n = 1 To 7
If n <= 5 Then
NrInWaitingRoom(n) = WorksheetFunction.Max(0, WorksheetFunction.Min(50, NrInWaitingRoom(n - 1) + MeanNrPatients(n) - 2 * (NrDoctorsPermanent + NrDoctorsHourly)))
Reward(n, NrDoctorsHourly, NrDoctorsPermanent) = 80 * NrDoctorsHourly + 325 / 7 * NrDoctorsPermanent + 150 * NrInWaitingRoom(n) + 800 * WorksheetFunction.Max(0, NrInWaitingRoom(n) + MeanNrPatients(n) - 2 * (NrDoctorsPermanent + NrDoctorsHourly) - 50)
Else
NrInWaitingRoom(n) = WorksheetFunction.Max(0, WorksheetFunction.Min(50, NrInWaitingRoom(n - 1) + MeanNrPatients(n) - 2 * (NrDoctorsPermanent + NrDoctorsHourly)))
Reward(n, NrDoctorsHourly, NrDoctorsPermanent) = 60 * NrDoctorsHourly + 325 / 7 * NrDoctorsPermanent + 150 * NrInWaitingRoom(n) + 800 * WorksheetFunction.Max(0, NrInWaitingRoom(n) + MeanNrPatients(n) - 2 * (NrDoctorsPermanent + NrDoctorsHourly) - 50)
End If
Next n
For n = 8 To 14
NrInWaitingRoom(n) = WorksheetFunction.Max(0, WorksheetFunction.Min(50, NrInWaitingRoom(n - 1) + MeanNrPatients(n) - 2 * (NrDoctorsPermanent + NrDoctorsHourly)))
Reward(n, NrDoctorsHourly, NrDoctorsPermanent) = 60 * NrDoctorsHourly + 275 / 7 * NrDoctorsPermanent + 150 * NrInWaitingRoom(n) + 800 * WorksheetFunction.Max(0, NrInWaitingRoom(n) + MeanNrPatients(n) - 2 * (NrDoctorsPermanent + NrDoctorsHourly) - 50)
Next n
For n = 15 To 20
NrInWaitingRoom(n) = WorksheetFunction.Max(0, WorksheetFunction.Min(50, NrInWaitingRoom(n - 1) + MeanNrPatients(n) - 2 * (NrDoctorsPermanent + NrDoctorsHourly)))
If n <= 19 Then
Reward(n, NrDoctorsHourly, NrDoctorsPermanent) = 80 * NrDoctorsHourly + 300 / 6 * NrDoctorsPermanent + 150 * NrInWaitingRoom(n) + 800 * WorksheetFunction.Max(0, NrInWaitingRoom(n) + MeanNrPatients(n) - 2 * (NrDoctorsPermanent + NrDoctorsHourly) - 50)
Else
Reward(n, NrDoctorsHourly, NrDoctorsPermanent) = 80 * NrDoctorsHourly + 300 / 6 * NrDoctorsPermanent + 150 * NrInWaitingRoom(n) + 800 * WorksheetFunction.Max(0, NrInWaitingRoom(n) + MeanNrPatients(n) - 2 * (NrDoctorsPermanent + NrDoctorsHourly))
End If
Next n
Next NrDoctorsHourly
Next NrDoctorsPermanent
For n = 1 To 20
For NrDoctorsPermanent = 0 To 120
Optimalhour(n, NrDoctorsPermanent) = 1E+15
Next NrDoctorsPermanent
Next n
‐----------------------
For NrDoctorsPermanent = 0 To 120
For NrDoctorsHourly = 0 To 120 - NrDoctorsPermanent
For n = 20 To 1 Step -1
NrInWaitingRoom(n) = WorksheetFunction.Max(0, WorksheetFunction.Min(50, NrInWaitingRoom(n - 1) + MeanNrPatients(n) - 2 * (NrDoctorsPermanent + NrDoctorsHourly)))
If Reward(n, NrDoctorsHourly, NrDoctorsPermanent) + Reward(n + 1, NrDoctorsHourly, NrDoctorsPermanent) < Optimalhour(n, NrDoctorsPermanent) And Reward(n, NrDoctorsHourly, NrDoctorsPermanent) + Reward(n + 1, NrDoctorsHourly, NrDoctorsPermanent) <> 0 Then Optimalhour(n, NrDoctorsPermanent) = Reward(n, NrDoctorsHourly, NrDoctorsPermanent) + Reward(n + 1, NrDoctorsHourly, NrDoctorsPermanent)
If Reward(n, NrDoctorsHourly, NrDoctorsPermanent) + Reward(n + 1, NrDoctorsHourly, NrDoctorsPermanent) = Optimalhour(n, NrDoctorsPermanent) Then Optimalreward(n, NrDoctorsPermanent) = Reward(n, NrDoctorsHourly, NrDoctorsPermanent)
Next n
Next NrDoctorsHourly
Shift1(NrDoctorsPermanent) = Optimalreward(1, NrDoctorsPermanent) + Optimalreward(2, NrDoctorsPermanent) + Optimalreward(3, NrDoctorsPermanent) + Optimalreward(4, NrDoctorsPermanent) + Optimalreward(5, NrDoctorsPermanent) + Optimalreward(6, NrDoctorsPermanent) + Optimalreward(7, NrDoctorsPermanent)
Shift2(NrDoctorsPermanent) = Optimalreward(8, NrDoctorsPermanent) + Optimalreward(9, NrDoctorsPermanent) + Optimalreward(10, NrDoctorsPermanent) + Optimalreward(11, NrDoctorsPermanent) + Optimalreward(12, NrDoctorsPermanent) + Optimalreward(13, NrDoctorsPermanent) + Optimalreward(14, NrDoctorsPermanent)
Shift3(NrDoctorsPermanent) = Optimalreward(20, NrDoctorsPermanent) + Optimalreward(19, NrDoctorsPermanent) + Optimalreward(18, NrDoctorsPermanent) + Optimalreward(17, NrDoctorsPermanent) + Optimalreward(16, NrDoctorsPermanent) + Optimalreward(15, NrDoctorsPermanent)
Next NrDoctorsPermanent
Shift1(91) = 1E+16
Shift2(91) = 1E+16
Shift3(91) = 1E+16
For NrDoctorsPermanent = 120 To 0 Step -1
If Shift1(NrDoctorsPermanent) < Shift1(NrDoctorsPermanent + 1) Then Optimalshift1 = Shift1(NrDoctorsPermanent)
If Shift1(NrDoctorsPermanent) < Shift1(NrDoctorsPermanent + 1) Then Sheets("Sheet1").Cells(15, 2) = NrDoctorsPermanent
If Shift2(NrDoctorsPermanent) < Shift2(NrDoctorsPermanent + 1) Then Optimalshift2 = Shift2(NrDoctorsPermanent)
If Shift2(NrDoctorsPermanent) < Shift2(NrDoctorsPermanent + 1) Then Sheets("Sheet1").Cells(15, 9) = NrDoctorsPermanent
If Shift3(NrDoctorsPermanent) < Shift3(NrDoctorsPermanent + 1) Then Optimalshift3 = Shift3(NrDoctorsPermanent)
If Shift3(NrDoctorsPermanent) < Shift3(NrDoctorsPermanent + 1) Then Sheets("Sheet1").Cells(15, 15) = NrDoctorsPermanent
Next NrDoctorsPermanent
Sheets("Sheet1").Cells(14, 2) = Optimalshift1
Sheets("Sheet1").Cells(14, 9) = Optimalshift2
Sheets("Sheet1").Cells(14, 15) = Optimalshift3
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

June7
05-24-2023, 02:54 PM
I don't see a dotted line of any color.

Could provide workbook for analysis. Follow instructions at bottom of my post.

Thymen123
05-24-2023, 03:18 PM
Excuse me, now there is!

Aussiebear
05-25-2023, 02:20 PM
1E+16 is huge number, what does it represent?