'文字列配列の作成と検索を行うマクロ

'文字列の挿入、削除、検索ができます。
'すでに配列にあるデータは挿入しません。

'SLU_ は String_List_Uniqueの略です。


Option Explicit


'扱うデータをまとめたユーザー定義型
Public Type SLU_Data
    List() As String
    No() As Integer
    Count As Integer
    Index As Integer
End Type


'データを初期化する関数
Public Function SLU_Init(slu As SLU_Data) As Boolean
    Erase slu.List
    Erase slu.No
    slu.Count = 0
    slu.Index = 0
    SLU_Init = True
End Function


'文字列配列を検索する関数
Public Function SLU_Search(slu As SLU_Data, ByVal sItem As String) As Boolean
    If slu.Count = 0 Then
        slu.Index = 0
        SLU_Search = False
    Else
        SLU_Search = BinarySearchString(slu, sItem)
    End If
End Function


'二分探索（配列の下限は1、上限はn）

'見つかったときTrue、見つからなかったときFalseを返します
'インデックスをslu.Indexにセットします

Private Function BinarySearchString(slu As SLU_Data, sItem As String) As Boolean
    Dim iLeft As Integer
    Dim iRight As Integer
    Dim iMid As Integer

    iLeft = 1
    iRight = slu.Count

    Do While iLeft <= iRight

        '中央のインデックスを取得する
        iMid = (iLeft + iRight) \ 2
        Select Case StrComp(sItem, slu.List(iMid), 1)
            Case -1
                '検索値が小さかった場合
                iRight = iMid - 1
            Case 1
                '検索値が大きかった場合
                iLeft = iMid + 1
            Case Else
                '等しい場合
                slu.Index = iMid
                BinarySearchString = True
                Exit Function
        End Select
    Loop

    slu.Index = iLeft
    BinarySearchString = False
End Function


'ソート済み配列に値を挿入する関数

'重複データは挿入しません

Public Function SLU_Insert(slu As SLU_Data, _
        ByVal sItem As String, ByVal iNo As Integer) As Boolean
    Dim i As Integer

    If BinarySearchString(slu, sItem) Then

        SLU_Insert = False

    Else

        '配列要素を追加
        slu.Count = slu.Count + 1
        ReDim Preserve slu.List(1 To slu.Count)
        ReDim Preserve slu.No(1 To slu.Count)

        '配列要素を1つ右へ移動
        For i = slu.Count - 1 To slu.Index Step -1
            slu.List(i + 1) = slu.List(i)
            slu.No(i + 1) = slu.No(i)
        Next

        '値の挿入
        slu.List(slu.Index) = sItem
        slu.No(slu.Index) = iNo

        SLU_Insert = True
    End If
End Function


'配列から値を削除する関数

Public Function SLU_Delete(slu As SLU_Data, ByVal sItem As String) As Boolean
    Dim i As Integer

    If slu.Count = 0 Then
        slu.Index = 0
        SLU_Delete = False
    Else
        If BinarySearchString(slu, sItem) Then

            '配列要素を1つ左へ移動
            For i = slu.Index To slu.Count - 1
                slu.List(i) = slu.List(i + 1)
                slu.No(i) = slu.No(i + 1)
            Next
            
            '配列要素数を減らす
            slu.Count = slu.Count - 1

            SLU_Delete = True
            
        Else
            slu.Index = 0
            SLU_Delete = False
        End If
    End If
End Function


'テストマクロ

'Sheet1のA列の文字列をC列へコピーします。
'重複は除かれ、昇順に並べ替えられます。
'D列に行番号を出力します。

Sub Test_StrListUnique()
    Dim slu As SLU_Data
    Dim oSheet As Worksheet
    Dim r As Range
    Dim i As Integer

    Set oSheet = Sheets("Sheet1")

    '配列にデータを挿入
    SLU_Init slu
    For Each r In oSheet.Cells(1, 1).CurrentRegion.Cells
        SLU_Insert slu, CStr(r.Value), r.Row
    Next

    '配列の出力
    For i = 1 To slu.Count
        oSheet.Cells(i, 3) = slu.List(i)
        oSheet.Cells(i, 4) = slu.No(i)
    Next
End Sub