エクセルで連続した同じアルファベットを持つ単語を抜き出す

質問

こんにちは　いつもお世話になっています。

エクセルで連続した同じアルファベットを持つ単語のセルを抜き出す方法を教えてください。

Ａ列に英単語があります。例えば、「commit」のように同じアルファベットが連続した部分を持つ単語を抜き出して（選択して？）Ｂ列に「重複」の文字を挿入したいのです。
アルファベットの重複は連続していればいくつでも構いませんし、単語のどの部分にあるかも問いません。
　よろしくお願いします。

回答No.5

mimeu · ベストアンサー

No.4 の訂正です。
アワテモノでお恥ずかしいです。

If InStr(i0 + 1, s0, Mid$(s0, i0, 1)) Then

を

If Mid$(s0, i0, 1) = Mid$(s0, i0+1, 1) Then

に変えれば連続になります。

お礼

mineu　様　ありがとうございました。
御陰様で成功しました。
お忙しいところ、迅速な回答を頂き痛み入ります。
コードの作り方も大変勉強になりました。
簡単で恐縮ですが、お礼申し上げます。

回答No.4

mimeu

手作り関数をワークシートで使う、って手もありますよ。

試し方
(1) 手作り関数を作る
　　　(1-1) Alt + F11 でＶＢＡコードの編集画面を表示する
　　　(1-2) 左の窓でお使いのＢｏｏｋ名を選択する
　　　(1-3) メニュー ＞ 挿入 ＞ 標準モジュール でモジュールを表示する
　　　(1-4) そこに以下のＶＢＡプログラムを貼り付ける

Public Function 重複(範囲 As Range) As String
　　Dim i0 As Integer, i9 As Integer, s0 As String
　　重複 = ""
　　s0 = 範囲.Text
　　i9 = Len(s0)
　　If i9 < 2 Then Exit Function
　　For i0 = 1 To i9 - 1
　　　　If InStr(i0 + 1, s0, Mid$(s0, i0, 1)) Then
　　　　　　重複 = "重複"
　　　　　　Exit Function
　　　　End If
　　Next i0
End Function

(2) ワークシート画面に戻り Ａ１セルから英単語が入ってるとすれば
　　Ｂ１セルに
　　=重複(A1)
　　と入力し、それを適宜下方にコピーする

もし英単語がとても多ければ、少し遅いと思いますけど。　（＾－＾）
Function ではなく Sub にすれば少しは速くなるかもしれません。

お礼

mimeu様　ありがとうございました。
　まことに恐縮ですが、部分的に手直しを教えていただけないでしょうか。アルファベットの重複のあるセルに対応するものの、「連続」という条件が含まれていないようです。不連続での重複のデータも取ってきてしまいます。このままでも、今後利用させていただきたいのですが、今回は「連続」した「重複」データを取りたいのです。
　取りあえず御礼まで

回答No.3

KURUMITO

Ｂ列に重複の文字でしたね。その場合にはＢ1セルへの入力の式は次のようになりますね。
=IF(A1="","",IF((IF(LEN(A1)>=1,IF(MID(A1,1,1)=MID(A1,2,1),1,0),0)+IF(LEN(A1)>=2,IF(MID(A1,2,1)=MID(A1,3,1),1,0),0)+IF(LEN(A1)>=3,IF(MID(A1,3,1)=MID(A1,4,1),1,0),0)+IF(LEN(A1)>=4,IF(MID(A1,4,1)=MID(A1,5,1),1,0),0)+IF(LEN(A1)>=5,IF(MID(A1,5,1)=MID(A1,6,1),1,0),0)+IF(LEN(A1)>=6,IF(MID(A1,6,1)=MID(A1,7,1),1,0),0)+IF(LEN(A1)>=7,IF(MID(A1,7,1)=MID(A1,8,1),1,0),0)+IF(LEN(A1)>=8,IF(MID(A1,8,1)=MID(A1,9,1),1,0),0)+IF(LEN(A1)>=9,IF(MID(A1,9,1)=MID(A1,10,1),1,0),0))>0,"重複",""))

お礼

KURUMITO　様　ありがとうございました。
　お陰さまで成功しました。長いコードでお手数をおかけしました。
簡単で恐縮ですが、お礼申し上げます。

回答No.2

KURUMITO

Ｂ1セルに次の式を入力し下方にオートフィルドラッグします。
=IF(A1="","",IF((IF(LEN(A1)>=1,IF(MID(A1,1,1)=MID(A1,2,1),1,0),0)+IF(LEN(A1)>=2,IF(MID(A1,2,1)=MID(A1,3,1),1,0),0)+IF(LEN(A1)>=3,IF(MID(A1,3,1)=MID(A1,4,1),1,0),0)+IF(LEN(A1)>=4,IF(MID(A1,4,1)=MID(A1,5,1),1,0),0)+IF(LEN(A1)>=5,IF(MID(A1,5,1)=MID(A1,6,1),1,0),0)+IF(LEN(A1)>=6,IF(MID(A1,6,1)=MID(A1,7,1),1,0),0)+IF(LEN(A1)>=7,IF(MID(A1,7,1)=MID(A1,8,1),1,0),0)+IF(LEN(A1)>=8,IF(MID(A1,8,1)=MID(A1,9,1),1,0),0)+IF(LEN(A1)>=9,IF(MID(A1,9,1)=MID(A1,10,1),1,0),0))>0,A1,""))
この式は文字が10までの文字列に対応しています。より多くの文字が考えられる場合には式を追加してください。

回答No.1

tom04

こんにちは！
参考になるかどうか判りませんが・・・
かなり無理矢理って感じの方法です。

↓の画像のように作業用の列を使わせてもらいます。
C列には「aa」・「bb」・・・「zz」 と全てアルファベットを二文字入力した列を作っておきます。
結局C2～C27までがアルファベットのデータになります。

そして、作業列B2セルに
=IF(OR(ISNUMBER(FIND($C$2:$C$27,A2))),ROW(A1),"")
これは配列数式になってしまいますので、
B2セルに貼り付け後、F2キーを押す、又はB2セルをダブルクリック、又は数式バー内で一度クリックします。
編集可能になりますのでShift＋Ctrl＋Enterキーで確定します。
数式の前後に｛　｝マークが入り配列数式になります。
このB2セルをオートフィルで下へずぃ～～～！っとコピーします。

最後に結果を表示させるセルE2セルに
=IF(COUNT($B$2:$B$100)<ROW(A1),"",INDEX($A$2:$A$100,SMALL($B$2:$B$100,ROW(A1))))
（これは配列数式ではありません。）
としてオートフィルで下へコピーすると画像のような感じになります。
これで同じアルファベットが二文字以上続いているものが表示されると思います。

以上、参考になれば良いのですが
他に良い方法があれば読み流してくださいね。m(__)m

お礼

tom04様　ありがとうございました。
　とても参考になりました。わかりやすく画像まで付けていただき助かりました。また、勉強させていただきます。
簡単で恐縮ですが、お礼申し上げます。