【VBA】重複データを部分一致で配列に格納する方法

Option Explicit
Sub PartialMatchDuplicateDataToArray()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Dim lastRow As Long, i As Long, j As Long
    Dim dataRange As Range
    Dim arr() As Variant
    Dim partialMatches() As String
    Dim isDuplicate As Boolean
    
    ' データ範囲を取得
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    Set dataRange = ws.Range("A2:A" & lastRow)
    arr = dataRange.Value
    
    ReDim partialMatches(0 To UBound(arr))
    For i = LBound(arr) To UBound(arr)
        isDuplicate = False
        For j = LBound(partialMatches) To i - 1
            If InStr(arr(i, 1), partialMatches(j)) > 0 Then
                ' 部分一致が見つかった場合、配列に格納しない
                isDuplicate = True
                Exit For
            End If
        Next j
        
        If Not isDuplicate Then
            ReDim Preserve partialMatches(UBound(partialMatches) + 1)
            partialMatches(UBound(partialMatches)) = arr(i, 1)
        End If
    Next i
    
    ' 配列の最後の要素を削除（空き領域をクリア）
    ReDim Preserve partialMatches(UBound(partialMatches) - 1)
    
    ' 結果表示（デバッグ用）
    For i = LBound(partialMatches) To UBound(partialMatches)
        Debug.Print partialMatches(i)
    Next i
End Sub