VBA - Wie erstellt man eine Warteschlange in einem Array? (FIFO) zuerst in first out

Question

Ich versuche, eine Warteschlange zu machen, die in der Lage ist, das First-in-First-Out-Konzept zu zeigen. Ich möchte ein Array haben, das als Warteliste funktioniert. Die Patienten, die später kommen, werden später entlassen. Es gibt eine Beschränkung von 24 Patienten im Raum, der Rest wird auf eine Warteliste gehen. Wenn der Raum leer ist, gehen die ersten Patienten aus dem Wartezimmer (die frühesten) in den Raum. Hier ist der Code, den ich bisher gefunden habe. Jede Hilfe wird sehr geschätzt.

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

Würden Sie Komintern "Class" -Ansatz nicht folgen (aber ich würde gehen mit es!) Sie können einen "Array" Ansatz wie folgt

setzen Sie den folgenden Code in einem Modul (Sie könnten es am unteren Rand der Code-Modul platzieren, aber Sie sollten es besser in ein neues Modul anrufen, 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 

dann in der Hauptunter könnten Sie so gehen:

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

Der einfachste Weg, dies zu tun, wäre eine einfache Klasse zu implementieren, die ein Collection wickelt. Sie könnte Wrap ein Array, aber Sie würden am Ende entweder kopieren es jedes Mal, wenn Sie ein Element aus der Warteschlange oder lassen Sie die aus der Warteschlange genommenen Elemente im Speicher sitzen.

in einem Klassenmodul (I genannt mine "Queue"):

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 

Verwendungsbeispiel:

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