文字列からアルファベットを抽出

ＥＸＣＥＬ2007を使用致しております。
下記のように不規則な文字列から英字（全角・半角）を抽出する方法をご教示願えましたら幸いです。かなり無理が有るでしょうか…　どうぞ宜しくお願い致します。


かきくけこkakikukeko
さしすせそsashisusesoたちつてと
naninunenoなにぬねの
【はひふへほ】hahihuheho
mamimumemo《まみむめも》
ＹＡＹＵＡＯやゆよ
『らりるれろ』rarirureroわをん1230

No.1 回答者： o_chi_chi 回答日時： 2011/03/30 12:16

下記でどうでしょう。

---
Sub test()
Dim objRE As Object
Dim objMData As Object
Dim objMatch As Object
Dim strPattern As String
Dim strMsg As String
Dim rngR As Range

Set objRE = CreateObject("VBScript.RegExp")
strPattern = "[a-zａ-ｚ]" '半角a-z全角ａ-ｚ
With objRE
.Pattern = strPattern '検索パターン
.IgnoreCase = True '大文字と小文字を区別しない
.Global = True '全体を検索
strMsg = ""
For Each rngR In ActiveSheet.UsedRange
Set objMData = .Execute(rngR.Value)
For Each objMatch In objMData
strMsg = strMsg & objMatch.Value
Next objMatch
Set objMData = Nothing
Next rngR
MsgBox strMsg
End With
Set objRE = Nothing
End Sub

この回答へのお礼

お礼が遅くなり申し訳ございませんでした。

ご教示頂きましたコードを試しましたが、何故か真っ白画面で動かなくなってしまいます。
今回はtom04さんにご教示頂いたVBEを使わせて頂きますが、お忙しいなかご教示くださりありがとうございました。

お礼日時：2011/04/01 14:24

No.2 回答者： MackyNo1 回答日時： 2011/03/30 14:38

関数で表示させるなら以下のような配列数式になります。

=MID(A1,MIN(IF((CODE(MID(ASC(A1&REPT(" ",99)),ROW($A$1:$A$99),1))>64)*(CODE(MID(ASC(A1&REPT(" ",99)),ROW($A$1:$A$99),1))<123),ROW($A$1:$A$99),"")),SUM((CODE(MID(ASC(A1&REPT(" ",99)),ROW($A$1:$A$99),1))>64)*(CODE(MID(ASC(A1&REPT(" ",99)),ROW($A$1:$A$99),1))<123)))

配列数式ですので、入力後Ｃｔｒｌ＋Ｓｈｉｆｔ＋Ｅｎｔｅｒで確定してください。

この回答へのお礼

お礼が遅くなり申し訳ございませんでした。

ご教示頂きましたコードを試しましたが、何故か英字を抽出する行と、数字やカタカナを抽出してしまう行が出来てしまいます。

提示させて頂いたsampleに問題が有ったのでしょうか…
今回はtom04さんにご教示頂いたVBEを使わせて頂きましたが、お忙しいなかご教示くださりありがとうございました。
..

お礼日時：2011/04/01 14:15

No.3 回答者： CoalTar 回答日時： 2011/03/30 16:00

英字がひとまとまりなら

=MID(A7,MIN(SEARCH($F$8:$F$33,ASC(A7)&"abcdefghijklmnopqrstuvwxyz")),
SUM((MID(A7,ROW(A$1:INDEX(A:A,LEN(A7))),1)>="a")
*(MID(A7,ROW(A$1:INDEX(A:A,LEN(A7))),1)<="z")))
[Ctrl]+[Shft] ＋[Enter] で確定、配列数式です({}で囲まれる)

No.4 回答者： CoalTar 回答日時： 2011/03/30 16:10

＃３です。

あわてて計算し忘れたまま載せてしまいました

A7セルの場合で
=MID(A7,MIN(SEARCH({"a";"b";"c";"d";"e";"f";"g";"h";"i";"j";"k";"l";"m";"n";"o";"p";"q";"r";"s";"t";"u";"v";"w";"x";"y";"z"},
ASC(A7)&"abcdefghijklmnopqrstuvwxyz")),
SUM((MID(A7,ROW(A$1:INDEX(A:A,LEN(A7))),1)>="a")
*(MID(A7,ROW(A$1:INDEX(A:A,LEN(A7))),1)<="z")))
[Ctrl]+[Shft] ＋[Enter] で確定、配列数式です({}で囲まれる)
サンプルは 変換できました

この回答へのお礼

お礼が遅くなり申し訳ございませんでした。

ご教示頂きましたコードを試しましたが、何故か英字を抽出する行と、数字やカタカナを抽出してしまう行が出来てしまいます。

提示させて頂いたsampleに問題が有ったのでしょうか…
今回はtom04さんにご教示頂いたVBEを使わせて頂きましたが、お忙しいなかご教示くださりありがとうございました。

お礼日時：2011/04/01 14:13

No.5 回答者： tom04 回答日時： 2011/03/30 18:38

こんばんは！

VBAになってしまいます。一例です。
一文字ずつ舐めるように検索する方法です。

データはA1セルからあり、B1セル以降に表示するとします。
画面左下にある操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面が出ますので
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub test() 'この行から
Dim i, k As Long
Dim str, buf As String
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
'↑A1セルからとしていますので、データがA2セル以降にあれば、For i = 2 To ・・・に変更
For k = 1 To Len(Cells(i, 1))
str = Mid(Cells(i, 1), k, 1)
If str Like "[A-Z]" Or str Like "[a-z]" Or str Like "[Ａ-Ｚ]" Or str Like "[ａ-ｚ]" Then
buf = buf & str
End If
Next k
Cells(i, 2) = buf
buf = ""
Next i
End Sub 'この行まで

こんな感じではどうでしょか？m(__)m

この回答へのお礼

お礼が遅くなってしまい申し訳ございません。
年度末の多忙でアクセス出来ずにおりました。

多くのご教示を沢山の皆様から頂戴し感謝致しております。
この場をお借り致しましてお礼申し上げます。

頂戴したsampleソースを全部試してみたところ、tom04様のVBEが一番理想の形でしたので、このソースを使わせて頂きたいと思います。
一点だけ補正が出来れば完璧なので、ご教示願えれば幸いです。お忙しいとは思いますが宜しくお願い致します。

あいうえおaiueoかきくけこkakikukekoさsa

上記のような場合に「aiueo」だけを抽出するにはどのように描き足したらよいでしょうか？（最初に出てくる一固まりの英字だけを抽出）何卒よろしくお願い致します。

お礼日時：2011/04/01 14:00

No.6 回答者： kagakusuki 回答日時： 2011/03/30 22:18

　英字部分が一纏まりになっていれば、次の関数で自動的に抽出させる事が出来ます。

　純粋な関数（配列数式ではない）なので、入力後のマクロボタン操作や、Ctrl+Shift+Enterキー操作は不要です。
　但し、Excel2007よりも前のバージョンのExcelに対しては非対応です。（質問者様のExcelはExcel2007という事ですから、対応しています）
※以下の例は、元の文字列がA1セルに存在している場合の関数です。

=IF(EXACT(UPPER(A1),LOWER(A1)),"",MID(A1,SUMPRODUCT(ROW(OFFSET(INDIRECT("Z1"),,,LEN(A1)))*ISNUMBER(FIND(MID(LOWER(ASC(A1)),ROW(OFFSET(INDIRECT("Z1"),,,LEN(A1))),1),"abcdefghijklmnopqrstuvwxyz"))*ISERROR(FIND(MID(" "&LOWER(ASC(A1)),ROW(OFFSET(INDIRECT("Z1"),,,LEN(A1))),1),"abcdefghijklmnopqrstuvwxyz"))),SUMPRODUCT(ISNUMBER(FIND(MID(LOWER(ASC(A1)),ROW(OFFSET(INDIRECT("Z1"),,,LEN(A1))),1),"abcdefghijklmnopqrstuvwxyz"))*1)))

この回答へのお礼

お礼が遅くなり申し訳ございませんでした。

ご教示頂きましたコードを試しましたが、何故か英字を抽出する行と、数字やカタカナを抽出してしまう行が出来てしまいます。

提示させて頂いたsampleに問題が有ったのでしょうか…
今回はtom04さんにご教示頂いたVBEを使わせて頂きましたが、お忙しいなかご教示くださりありがとうございました。

お礼日時：2011/04/01 14:11

No.7 回答者： tom04 回答日時： 2011/04/01 20:23

No.5です。

＞最初に出てくる一固まりの英字だけを抽出・・・

とありましたので、再び顔を出しました。

↓のようなコードではどうでしょうか？

Sub test()
Dim i, k As Long
Dim str, buf As String
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
For k = 1 To Len(Cells(i, 1))
str = Mid(Cells(i, 1), k, 1)
If str Like "[A-z,Ａ-ｚ]" Then
buf = buf & str
End If
If Len(buf) > 0 And Not str Like "[A-z,Ａ-ｚ]" Then Exit For
Next k
Cells(i, 2) = buf
buf = ""
Next i
End Sub

お役に立てれば良いのですが・・・m(__)m

この回答へのお礼

ご教示くださりありがとうございます。

"[" や "]" が英字と共に抽出されてしまいますがほぼ完璧です^^
「かきくkakiku kekoけこ」のデータで「kakikukeko」も抽出したかったので"[A-z,Ａ-ｚ, ,　]"と書き足したら「kakikukeko」と抽出してくれました。しかし「　かきくkakiku kekoけこ」の場合も「　kakikukeko」となるので前のスペースは消したいところです。

上記のような不備は今のところスルーできますが、お暇が有ればまたご教示頂ければ助かります。厚かましいお願いですがほんとにお暇な時にお願いできれば幸いです。それまでは自分で試行錯誤してみたいと思います^^

データ整理に時間を取られ非常に困っておりましたが、今後がとても楽になれると思い感謝の気持ちでいっぱいです。ありがとうございました。上記の"["やスペースのご教示も頂けることを期待して暫く〆ずに待たせて頂きます事をご了承願いますm(_ _)m

お礼日時：2011/04/02 07:24

No.8 ベストアンサー 回答者： tom04 回答日時： 2011/04/02 10:56

またまたお邪魔します。

[ ] やスペースが邪魔のようですので・・・

考え方としてはアルファベットを抽出前に「[ ]」を削除したデータを利用するか、
「[ ]」を抽出後に削除するかのどちらかだと思います。

とりあえず、前者の方法で作業用の列としてC列を使っています。

尚、抽出時に「スペース」は抽出しないでアルファベット・スペース以外の文字が出るまでループを繰り返すようにしていますので、
仮に「Aiueo kakikukeko」のような場合でもスペースがなくなり「AiueoKakikukeko」となってしまいます。

Sub test()
Dim i, k As Long
Dim str, buf As String
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
Cells(i, 3) = WorksheetFunction.Substitute _
(WorksheetFunction.Substitute(Cells(i, 1), "]", ""), "[", "")
For k = 1 To Len(Cells(i, 3))
str = Mid(Cells(i, 3), k, 1)
If str Like "[A-z,Ａ-ｚ]" Then
buf = buf & str
End If
If Len(buf) > 0 And Not str Like "[A-z,Ａ-ｚ, ]" Then Exit For
Next k
Cells(i, 2) = buf
buf = ""
Next i
Columns(3).ClearContents
End Sub

こんな感じではどうでしょうか？m(__)m

この回答へのお礼

ご丁寧に何度も教えて頂き、ありがとうございます。
作業がかなり楽になりました。本当に便利なものですね！
自分でもVBEを書けるように勉強したいと思いますが、道のりは遠そうです^^;
使っていて不具合が2箇所ほどあったので、更に更に厚かましいですがご教示頂けましたら幸いです。
別スレ同タイトルにて質問させて頂きました。お時間がございます時で結構ですのでご教示頂けましたら幸いです。宜しくお願いいたします。

お礼日時：2011/04/04 10:19