【VBA】Excelののセルを利用したスタック（Pop/Push）の実装サンプルコード

スタックのイメージと勉強のため調査

スタックといえば、後入れ先出し（LIFO: Last In First Out; FILO: First In Last Out）

データ入れることをPop、データ出すことをPushと言う。

Unixやdosコマンドでもpopd pushdコマンドでフォルダ（ディレクトリ）を保存したり取り出したりすることができるが、これもスタックを活用している。

ＶＢＡソースコードの例

参考サイト　はこちら

ここのコードにちょっとコメントを追加しただけ。。

セル（C2:C22）をスタックと見立て、そこにデータをデータ入れるたり（Pop）、データ出したり（Push）。入れるデータはランダムデータを３つ、出すデータは最後のデータ１つとなっている。

‘VBAで実装するスタックのサンプル
Option Explicit

Dim DinamicRange As Range
Dim EventNr As Long
Dim ItemsArr(1 To 3)
Dim StoredValue() As Variant

‘Push(1回実行すると、C2:C22の範囲で3つランダムデータがPush（インプット）される。)
Sub Push()
   
    Dim J As Integer
    Dim PopulatedCells As Range
   
    Set DinamicRange = Range("C2:C22")
    On Error Resume Next
    With DinamicRange
        If .SpecialCells(xlCellTypeBlanks).Count < 3 Then
            MsgBox "Stack Full", vbExclamation
            Exit Sub
        End If
        ‘POP用ランダムデータ作成
        Do
            Randomize ‘乱数ジェネレータを初期化
            EventNr = Int((100 * Rnd) + 1)
            If Int(EventNr / 2) = (EventNr / 2) Then
                J = J + 1
                ItemsArr(J) = EventNr
            End If
        Loop While J < 3
        Set PopulatedCells = .SpecialCells(xlCellTypeConstants)
        If PopulatedCells Is Nothing Then
            .Cells(.Cells.Count) = ItemsArr(1)
            .Cells(.Cells.Count – 1) = ItemsArr(2)
            .Cells(.Cells.Count – 2) = ItemsArr(3)
        Else
            StoredValue = PopulatedCells.Value
            Set PopulatedCells = PopulatedCells.Offset(-3)
            PopulatedCells.Value = StoredValue
            .Cells(.Cells.Count, 1) = ItemsArr(1)
            .Cells(.Cells.Count – 1) = ItemsArr(2)
            .Cells(.Cells.Count – 2) = ItemsArr(3)
        End If
    End With
End Sub

‘Pop(1回実行すると、C2:C22の範囲で最も古いデータが取り出される。（削除される）)
Sub Pop()
    On Error Resume Next
   
    Dim PopulatedCells As Range
   
    Set DinamicRange = Range("C2:C22")
    With DinamicRange
        Set PopulatedCells = .SpecialCells(xlCellTypeConstants)
        If PopulatedCells Is Nothing Then
            MsgBox "No more Items to pull !", vbCritical
        Else
            StoredValue = PopulatedCells.Value
            Set PopulatedCells = PopulatedCells.Offset(1).Resize(PopulatedCells.Offset(1).Rows.Count)
            PopulatedCells.Value = StoredValue
            PopulatedCells.Cells(1).Offset(-1).ClearContents
            PopulatedCells.Cells(PopulatedCells.Rows.Count).ClearContents
        End If
    End With
End Sub