VBA - Comment faire une file d'attente dans un tableau? (FIFO) premier entré, premier sorti

Question

J'essaie de faire une file d'attente capable de montrer le concept du premier entré, premier sorti. Je veux avoir un tableau qui fonctionne comme une liste d'attente. Les patients qui viennent plus tard seront libérés plus tard. Il y a une limite de 24 patients dans la salle, le reste ira sur une liste d'attente. chaque fois que la pièce est vide, les premiers patients de la salle d'attente (la première) vont dans la pièce. Voici le code que j'ai trouvé jusqu'à présent. Toute aide est grandement appréciée.

Dim arrayU() As Variant 
    Dim arrayX() As Variant 
    Dim arrayW() As Variant 
    Dim LrowU As Integer 
    Dim LrowX As Integer 
    Dim LrowW As Integer 
    'Dim i As Integer 
    Dim j As Integer 
    Dim bed_in_use As Integer 

    LrowU = Columns(21).Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 
    LrowX = Columns(24).Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 
    LrowW = Columns(23).Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 

    ReDim arrayU(1 To LrowU) 
    ReDim arrayX(1 To LrowX) 
    ReDim arrayW(1 To LrowW) 

    For i = 3 To LrowU 
     arrayU(i) = Cells(i, 21) 
    Next i 

    i = 3 

    For i = 3 To LrowX 
     arrayX(i) = Cells(i, 24) 
    Next i 

    i = 3 
    j = 3 

    For r = 3 To LrowW 
     arrayW(r) = Cells(r, 23) 
    Next r 
    r = 3 
    i = 3 
    j = 3 


    For i = 3 To LrowX ' the number of bed in use is less than 24 (HH) 
     If bed_in_use >= 24 Then GoTo Line1 
    For j = 3 To LrowU 
     If bed_in_use >= 24 Then GoTo Line1 
      If arrayX(i) = arrayU(j) Then 
      If Wait_L > 0 Then 
      Wait_L = Wait_L - (24 - bed_in_use) 
      Else 
      bed_in_use = bed_in_use + 1 

      End If 
      End If 

     Next j 

Line1: 

    For r = 3 To LrowW 
      If bed_in_use < 24 Then Exit For 
      If arrayX(i) = arrayW(r) Then 
      bed_in_use = bed_in_use - 1 
      Wait_L = Wait_L + 1 


     End If 
    Next r 

     Cells(i, "Y").Value = bed_in_use 
    Cells(i, "Z").Value = Wait_L 
Next i 

Answer 1

N'êtes-vous pas suivre "classe" de Komintern (mais je partirais avec il!) vous pouvez coller à une approche "tableau" comme suit

placer le code suivant dans un module (vous pouvez le placer en bas de votre module de code, mais vous feriez mieux de le placer dans un nouveau module appeler, m aybe, "QueueArray" ...)

Sub Clear(myArray As Variant) 
Erase myArray 
End Sub 


Function Count(myArray As Variant) As Long 
If isArrayEmpty(myArray) Then 
    Count = 0 
Else 
    Count = UBound(myArray) - LBound(myArray) + 1 
End If 
End Function 


Function Peek(myArray As Variant) As Variant 
If isArrayEmpty(myArray) Then 
    MsgBox "array is empty! -> nothing to peek" 
Else 
    Peek = myArray(LBound(myArray)) 
End If 
End Function 


Function Dequeue(myArray As Variant) As Variant 
If isArrayEmpty(myArray) Then 
    MsgBox "array is empty! -> nothing to dequeue" 
Else 
    Dequeue = myArray(LBound(myArray)) 
    PackArray myArray 
End If 
End Function 


Sub Enqueue(myArray As Variant, arrayEl As Variant) 
Dim i As Long 

EnlargeArray myArray 
myArray(UBound(myArray)) = arrayEl 

End Sub 


Sub PackArray(myArray As Variant) 
Dim i As Long 

If LBound(myArray) < UBound(myArray) Then 
    For i = LBound(myArray) + 1 To UBound(myArray) 
     myArray(i - 1) = myArray(i) 
    Next i 
    ReDim Preserve myArray(LBound(myArray) To UBound(myArray) - 1) 
Else 
    Clear myArray 
End If 

End Sub 


Sub EnlargeArray(myArray As Variant) 
Dim i As Long 

If isArrayEmpty(myArray) Then 
    ReDim myArray(0 To 0) 
Else 
    ReDim Preserve myArray(LBound(myArray) To UBound(myArray) + 1) 
End If 
End Sub 


Public Function isArrayEmpty(parArray As Variant) As Boolean 
'http://stackoverflow.com/questions/10559804/vba-checking-for-empty-array 
'assylias's solution 

'Returns true if: 
' - parArray is not an array 
' - parArray is a dynamic array that has not been initialised (ReDim) 
' - parArray is a dynamic array has been erased (Erase) 

    If IsArray(parArray) = False Then isArrayEmpty = True 

    On Error Resume Next 

    If UBound(parArray) < LBound(parArray) Then 
     isArrayEmpty = True 
     Exit Function 
    Else 
     isArrayEmpty = False 
    End If 

End Function 

alors dans votre principale sous vous pouvez aller comme ceci:

Option Explicit 

Sub main() 

    Dim arrayU As Variant 
    Dim arrayX As Variant 
    Dim arrayW As Variant 

    Dim myVar As Variant 

    Dim j As Integer, i As Integer, R As Integer 
    Dim bed_in_use As Integer, Wait_L As Integer 

    Dim arrayXi As Variant 
    Const max_bed_in_use As Integer = 24 'best to declare a "magic" value as a constant and use "max_bed_in_use" in lieu of "24" in the rest of the code 

    'fill "queue" arrays 
    With ActiveSheet 
     arrayU = Application.Transpose(.Range(.cells(3, "U"), .cells(.Rows.Count, "U").End(xlUp))) 'fill arrayU 
     arrayX = Application.Transpose(.Range(.cells(3, "X"), .cells(.Rows.Count, "X").End(xlUp))) 'fill arrayX 
     arrayW = Application.Transpose(.Range(.cells(3, "W"), .cells(.Rows.Count, "W").End(xlUp))) 'fill arrayW 
    End With 


    'some examples of using the "queue-array utilities" 
    bed_in_use = Count(arrayU) 'get the number of elements in arrayU 
    Enqueue arrayU, "foo" ' add an element in the arrayU queue, it'll be placed at the queue end 
    Enqueue arrayU, "bar" ' add another element in the arrayU queue, it'll be placed at the queue end 
    bed_in_use = Count(arrayU) 'get the update number of elements in arrayU 

    Dequeue arrayU 'shorten the queue by removing its first element 
    myVar = Dequeue(arrayU) 'shorten the queue by removing its first element and storing it in "myvar" 
    bed_in_use = Count(arrayU) 'get the update number of elements in arrayU 

    MsgBox Peek(arrayU) ' see what's the first element in the queue 


End Sub 

Answer 2

meilleure façon de faire serait de mettre en œuvre une classe simple qui enveloppe un Collection. Vous pouvez envelopper un tableau, mais vous finiriez par avoir à le copier chaque fois que vous avez retiré un élément ou laissé des objets en file d'attente en mémoire.

Dans un module de classe (je nommé le mien "file d'attente"):

Option Explicit 

Private items As New Collection 

Public Property Get Count() 
    Count = items.Count 
End Property 

Public Function Enqueue(Item As Variant) 
    items.Add Item 
End Function 

Public Function Dequeue() As Variant 
    If Count > 0 Then 
     Dequeue = items(1) 
     items.Remove 1 
    End If 
End Function 

Public Function Peek() As Variant 
    If Count > 0 Then 
     Peek = items(1) 
    End If 
End Function 

Public Sub Clear() 
    items = New Collection 
End Sub 

Exemple d'utilisation: approche

Private Sub Example() 
    Dim q As New Queue 

    q.Enqueue "foo" 
    q.Enqueue "bar" 
    q.Enqueue "baz" 

    Debug.Print q.Peek   '"foo" should be first in queue 
    Debug.Print q.Dequeue  'returns "foo". 
    Debug.Print q.Peek   'now "bar" is first in queue. 
    Debug.Print q.Count   '"foo" was removed, only 2 items left. 
End Sub