VBA - 如何在数组中创建队列？ （FIFO）先进先出

Posted 2021-04-13

我正在尝试建立一个能够显示先出先出概念的队列。我想要一个作为等待名单的数组。后来的病人将在晚些时候出院。在这个房间里有24名病人的限制，其余的将进入等待名单。每当房间空无一人时，等候室（最早）的第一批病人就会前往房间。这是我到目前为止提出的代码。任何帮助是极大的赞赏。

    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

答案

你不会遵循共产国际的“阶级”方法（但我会继续它！）你可以坚持一个像“阵列”的方法，如下

将以下代码放在任何模块中（您可以将它放在代码模块的底部，但最好将它放在一个新模块中调用，也许，“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

然后在你的主要子你可以这样：

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

另一答案

最简单的方法是实现一个包装Collection的简单类。你可以包装一个数组，但是每次你将一个项目出列或让出列的项目都放在内存中时，你最终都要复制它。

在Class模块中（我将其命名为“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()
    Set items = New Collection
End Sub

样品用法：

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