Excel2007でカタカナの文字のみを抽出、表示するには？

表題のとおりExcel2007でカタカナの文字のみを抽出し、となりのセルに表示する方法を探しています。

具体的には、

　　　　　　Ａ列　　　　　　　　　　　　　Ｂ列
意識がモウロウとしている。　　モウロウ
カミシモを脱いで談笑する。　　カミシモ

といった感じで表示させたいのですが、可能でしょうか。
また、同様に半角文字のみをとなりのセルに表示させる方法も探しています。
なるべく早くご教授くだされば幸いです。

No.4 ベストアンサー 回答者： MackyNo1 回答日時： 2009/11/22 18:09

たとえば、半角文字を抽出するなら以下のような数式がわかりよいかもしれません。

=MID(A1,MIN(INDEX((MID(A1,ROW($A$1:$A$100),1)=MID(JIS(A1),ROW($A$1:$A$100),1))*100+ROW($A$1:$A$100),)),LENB(JIS(A1))-LENB(A1))

No.5 回答者： Wendy02 回答日時： 2009/11/23 02:02

こんばんは。

ユーザー定義関数です。あまり多くなるとシートが重くなりますので、必要に応じて、コピー--値貼り付けにします。

数式は、

=KtPickUp(A1)　半角・全角両方
=KtPickUp(A1,1)　半角
=KtPickUp(A1,2)　全角

※標準モジュールへの取り付け方：

Alt　+　 F11 (Altを押しながらF11）を押すと、Visual Basic Editor 画面が出てきます。
次に、メニューの[挿入]－[標準モジュール]と開けて、クリックすると、画面が現れますので、以下のコードを貼り付けて、

Alt　+　Q で、画面を閉じます。

'-------------------------------------------
Function KtPickUp(ByVal rng As Range, Optional i As Integer) As String
　'オプション なし、全角・半角カタカナ両方,　1　半角, 2 全角
　　Dim Matches As Object
　　Dim Match As Object
　　Dim buf As Variant
　　If VarType(rng.Value) = vbString Then
　　　　With CreateObject("VBScript.RegExp")
　　　　　　　 .Global = False
　　　　　　If i = 1 Then
　　　　　　　.Pattern = "[\uFF61-\uFF9F]+" '半角
　　　　　　ElseIf i = 2 Then
　　　　　　　.Pattern = "[\u30A1-\u30FA]+"　'全角
　　　　　　Else
　　　　　　　.Pattern = "[\u30A1-\u30FA\uFF61-\uFF9F]+"　'両方
　　　　　　　.Global = True
　　　　　　End If
　　　　　　　
　　　　　　Set Matches = .Execute(rng.Value)
　　　　　　For Each Match In Matches
　　　　　　　　buf = buf & Match
　　　　　　Next
　　　　End With
　　　　KtPickUp = buf
　　Else
　　　　KtPickUp = rng.Value
　　End If
End Function

この回答へのお礼

皆様、ご丁寧なご回答まことにありがとうございました。
説明してくださっている文章は、Excelの知識が乏しい私には難しく理解できませんでした。Excelの基礎をもう一度、一から学んでみたいと存じます。
また何かわからない点がございました折には、何卒ご教授のほどよろしくお願いいたします。
これをもちまして皆様へのお礼とさせていただきたく存じます。

お礼日時：2009/12/01 09:30

No.3 回答者： xls88 回答日時： 2009/11/22 17:58

試しにマクロを組んでみました。

全角カタカナ文字を抽出します（と思います）。
対象セル範囲を選択しておいて実行してください。

Sub test1()
Dim myCell As Range
Dim myChr As String
Dim myStr As String
Dim n As Integer
Dim i As Integer

For Each myCell In Selection
n = Len(myCell.Value)
For i = 1 To n Step 1
myChr = Mid(myCell.Value, i, 1)
If myChr Like "[ァ-ヶ]" Then
myStr = myStr & myChr
End If
Next i
myCell.Offset(, 1).Value = myStr
myStr = ""
Next myCell
End Sub

半角文字の場合は、バイト数で判定すれば良いかもしれません。

No.2 回答者： CoalTar 回答日時： 2009/11/22 17:46

＞また、同様に半角文字のみをとなりのセルに表示させる方法も探しています。

を見逃していました。 といっても、同様な方法で
半角文字がつながっていることが条件。
=IF(LEN(A1)*2=LENB(A1),"",
MID(A1,MATCH(FALSE,MID(A1,COLUMN($A$1:INDEX($1:$1,LEN(A1))),1)=
MID(JIS(A1),COLUMN($A$1:INDEX($1:$1,LEN(A1))),1),0),LEN(A1)*2-LENB(A1)))
[Ctrl]+[Shift] ＋[Enter] で確定

#もっとスマートな方法がありそうだけど・・・良くわかりませんm(_ _)m

No.1 回答者： CoalTar 回答日時： 2009/11/22 17:31

こんなん 数式で出してもいいのだろうか・・・と思いつつ

一単語のみ、エラー処理なし。
=MID(A1,
MATCH(1,(CODE(MID(A1,COLUMN($A$1:INDEX($1:$1,LEN(A1))),1))>=9505)*
(CODE(MID(A1,COLUMN($A$1:INDEX($1:$1,LEN(A1))),1))<=9588),0),
SUM((CODE(MID(A1,COLUMN($A$1:INDEX($1:$1,LEN(A1))),1))>=9505)*
(CODE(MID(A1,COLUMN($A$1:INDEX($1:$1,LEN(A1))),1))<=9588)))
[Ctrl]+[Shift] ＋[Enter] で確定、配列数式です({}で囲まれる)
下へオートフィル