我正在尝试建立一个能够显示先出先出概念的队列。我想要一个作为等待名单的数组。后来的病人将在晚些时候出院。在这个房间里有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