Excelにて、カタカナだけのセルを抜き出す方法は？

質問

Excelファイルにおいて、複数のワークシートにランダムに文字列が入力されている状態です。
ランダムといっても入力されている範囲はある程度限られていますが、定型ではありません。
このような状態から、カタカナのみの文字列が入力されているセルの文字列を抽出し、新たなワークシートに出力する方法はありますでしょうか？
抽出した文字は、新しいワークシートに１列に並べたいのです。
良い方法がありましたらお教え下さい。
よろしくお願いいたします。

回答No.3

matsu_jun · ベストアンサー

#2の補足を、他人ですが回答させていただきます。

> If chk >= 9506 And chk <= 9587 Then
私も確認したのですが、全角カタカナは、-32438(濁点)、-32437(半濁点)、-32421(長音「－」)、-31936(ァ)～-31853(ン)(ただし、-31873は「・」です)の範囲にわたっています。
また、半角カタカナですが、177からではなく166からです(ヲとァ(小さいア)～ー)。また、221まででなく223までです。(222が濁点、223が半濁点)

また、#2さんのマクロの例では、各セルの先頭の文字しか確認していないようですので、
> chk = Asc(chk_str)
> If chk >= 177 And chk <= 221 Then
の部分は

Dim StrChk As Boolean
StrChk = True
For n# = 1 To Len(chk_str)
If Asc(Mid(chk_str, i, 1)) < 166 Or 224 < Asc(Mid(chk_str, i, 1)) Then
'面倒なので全角カナの条件は書いていません。上を参照にして下さい。
StrChk = False
Exit For
End If
Next i
If StrChk = True Then (chk_strを新シートへコピーする処理)

とした方がよいでしょう。
上のルーチンは、あるセルの値(chk_str)を先頭から一文字ずつ取り出し、カタカナでない文字を発見した時点でStrChkフラグをFalseにします。全ての文字がカタカナであった場合のみコピー処理をするというものです。

> Worksheets(LS_N).Cells(rr, 1).Value = chk_str
LS_Nが、新シートを挿入する前の末尾のシート名を格納しているからじゃないでしょうか？
ここは、
Worksheets(S_C+1)でいいのではないでしょうか？

申し訳ないですが、上のコードは全く動かしていないので、間違っているかもしれません。違っていたら補足で報告いただければ時間を割いて検証しますよ。

お礼

ありがとうございます。
おかげさまでうまくいきました。
完成形は以下のとおりです。

Sub test()
S_C = ActiveWorkbook.Sheets.Count
LS_N = Sheets(S_C).Name
rr = 1
Set NewSheet = Sheets.Add(After:=ActiveWorkbook.Sheets(LS_N), Type:=xlWorksheet)
For i = 1 To S_C
EndRow = Worksheets(i).UsedRange.Rows.Count + Worksheets(i).UsedRange.Row - 1
EndCol = Worksheets(i).UsedRange.Columns.Count + Worksheets(i).UsedRange.Column - 1
For j = 1 To EndCol
For k = 1 To EndRow
chk_str = Worksheets(i).Cells(k, j).Value
If chk_str = Empty Then
chk_str = " "
End If
Dim StrChk As Boolean
StrChk = True
For n# = 1 To Len(chk_str)
If Asc(Mid(chk_str, n#, 1)) < -32438 Or -31853 < Asc(Mid(chk_str, n#, 1)) Then
StrChk = False
Exit For
End If
Next n#
If StrChk = True Then
Worksheets(S_C + 1).Cells(rr, 1).Value = chk_str
rr = rr + 1
End If
Next k
Next j
Next i
End Sub

回答No.2

WWolf

急いで作成したので半角カタカナ対応です。
またＩＦ文でカタカナを判別しているのでＭｓｇＢｏｘ文を消し新規シートにその内容を追加するマクロを作ってください。
Sub test()
S_C = ActiveWorkbook.Sheets.Count
LS_N = Sheets(S_C).Name
Set NewSheet = Sheets.Add(After:=ActiveWorkbook.Sheets(LS_N), Type:=xlWorksheet)
For i = 1 To S_C
EndRow = Worksheets(i).UsedRange.Rows.Count + Worksheets(i).UsedRange.Row - 1
EndCol = Worksheets(i).UsedRange.Columns.Count + Worksheets(i).UsedRange.Column - 1
For j = 1 To EndCol
For k = 1 To EndRow
chk_str = Worksheets(i).Cells(k, j).Value
If chk_str = Empty Then
chk_str = " "
End If
chk = Asc(chk_str)
If chk >= 177 And chk <= 221 Then
MsgBox "行＝" & k & " 列＝" & j & Chr$(13) & Chr$(13) & "文字列＝ " & chk_str, , "カタカナ"
End If
Next k
Next j
Next i

End Sub

補足

ご回答ありがとうございます。
さっそく、試してみたところ、半角カタカナを順番にボックス表示させることはできました。
ところが、文字コードの範囲を全角カタカナの9506～9587に置き換えてみたところ、全角カタカナを拾ってくれません。

If chk >= 9506 And chk <= 9587 Then

また、新しいワークシートの左上から縦に順番に書き出したいのですが、以下のようにしてもうまくいきませんでした。

rr=1
・
・
Worksheets(LS_N).Cells(rr, 1).Value = chk_str
rr = rr + 1

何が問題なのでしょうか？
マクロはあまり詳しくないものですから、いろいろとご面倒をおかけしますが、解決方法が分かりましたらお教え下さい。
よろしくお願いいたします。

回答No.1

macchan1

例えば関数とオートフィルタを利用するなら以下のような操作をします。

例えばA列にその文字列が入力されている場合、E1セルに以下の式を入力して右方向及び下方向にオートフィルします。
=IF(LEN($A1)<COLUMN(B1),"",CODE(MID($A1,COLUMN(B1),1)))

D1セルに以下の数式を入力して下方向にオートフィルし、この列を基準に○をオートフィルタして抽出結果を別シートにコピー貼り付けして下さい。

=IF(SUMPRODUCT((D1:Y1>=9506)*(D1:Y1<=9587))=LEN($A1),"○","")

補足

さっそくのご回答ありがとうございます。
関数の部分は非常に参考になりそうです。
ただし、入力範囲の列が1列ではなく、また、途中に空白セルなどもあり、さらにシートが複数にまたがっているのです。
ですので、オートフィルタを用いる方法ですと手間がかかりすぎると思われるのです。
マクロを利用する形でも良いので一括処理できる方法はないでしょうか？
面倒な質問で申し訳ありません。