VBA - 如何在数组中创建队列？ (FIFO) 先进先出
VBA - How to make a queue in an array? (FIFO) first in first out
我正在尝试制作一个能够显示先进先出概念的队列。我想要一个数组作为等待列表。来得晚的病人，出院时间会晚些。房间内有 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
最简单的方法是实现一个包含 Collection 的简单 class。您可以 包装一个数组，但您最终要么必须在每次出队时复制它，要么让出队的项目留在内存中。
在 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
你能不遵循共产国际的 "Class" 方法吗（但我会同意！）你可以坚持 "array" 方法，如下
将以下代码放在任何模块中（你可以把它放在你代码模块的底部，但你最好把它放在一个新的模块中调用，也许，"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
'
'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
我正在尝试制作一个能够显示先进先出概念的队列。我想要一个数组作为等待列表。来得晚的病人，出院时间会晚些。房间内有 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
最简单的方法是实现一个包含 Collection 的简单 class。您可以 包装一个数组，但您最终要么必须在每次出队时复制它，要么让出队的项目留在内存中。
在 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
你能不遵循共产国际的 "Class" 方法吗（但我会同意！）你可以坚持 "array" 方法，如下
将以下代码放在任何模块中（你可以把它放在你代码模块的底部，但你最好把它放在一个新的模块中调用，也许，"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
'
'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