[VBA] 同じ文字数で奇数番目だけが違うものをグルーピング

https://twitter.com/toshi81350036/status/1767883983558443448

#Excelクイズ #VBAクイズ #何でもOK
A列に任意の文字列のひらがなを列挙したとして、その中から引用RTの条件に合致する組み合わせを抽出せよ https://t.co/gMVOqCA2aU

— としじ (@toshi81350036) March 13, 2024

以下、コード

Sub 同じ文字数で奇数番目だけが違うものをグルーピング()
    
    Dim dic: Set dic = CreateObject("Scripting.Dictionary")
    Dim i, j, s, strName
    
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        strName = Cells(i, 1).Value
        s = ""
        For j = 1 To Len(strName)
            Select Case True
                Case j Mod 2 = 1: s = s & " ? "
                Case Else:        s = s & Mid(strName, j, 1)
            End Select
        Next
        Select Case True
            Case dic.Exists(s): dic(s) = dic(s) & ", " & strName
            Case Else:          dic(s) = strName
        End Select
    Next
    
    Range("c:d").Clear
    
    Dim key
    For Each key In dic.keys
        If InStr(1, dic(key), ", ") > 0 Then
            With Cells(Rows.Count, 3).End(xlUp)
                .Offset(1).Value = key
                .Offset(1, 1).Value = dic(key)
            End With
        End If
    Next

End Sub

個人情報ジェネレータで適当に生成したやつでやってみた
（1万件生成して重複削除だけ実施したもの）

名字の文字数が違う人でもヒットしてるの見るとちょっと「おぉー」となる

追記：Excelでもやってみた