![見出し画像](https://assets.st-note.com/production/uploads/images/133885338/rectangle_large_type_2_66412f5de076cb5ed615d4971015c599.jpeg?width=1200)
[VBA] 同じ文字数で奇数番目だけが違うものをグルーピング
https://twitter.com/toshi81350036/status/1767883983558443448
#Excelクイズ #VBAクイズ #何でもOK
— としじ (@toshi81350036) March 13, 2024
A列に任意の文字列のひらがなを列挙したとして、その中から引用RTの条件に合致する組み合わせを抽出せよ https://t.co/gMVOqCA2aU
以下、コード
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万件生成して重複削除だけ実施したもの)
![](https://assets.st-note.com/img/1710388930593-7RySTsEwrv.png?width=1200)
名字の文字数が違う人でもヒットしてるの見るとちょっと「おぉー」となる
追記:Excelでもやってみた
![](https://assets.st-note.com/img/1710458545223-yVV5OnoenK.png?width=1200)
この記事が気に入ったらサポートをしてみませんか?