exel行の中で一番初めに出てきたカタカナ単語抽出

質問

exelで各行にあるカタカナと他の文字が混じったテキストの中から一番初めに出てきたカタカナ単語だけ一括複数で抽出したいのですが下の式を使うとカタカナ以外も抽出してしまいます　マクロを含め各行にあるカタカナと他の文字が混じったテキストの中から一番初めに出てきたカタカナ単語だけを一括複数で抽出できる式を教えて下さい

=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))<=9590),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))<=9590)))

回答No.12

HohoPapa · ベストアンサー

>マクロの実行の仕方がわかりません

添付画像のように、標準モジュールを追加し、
掲示したコードを標準モジュールにコピペします。
シート上に、サンプル画像のように関数式を埋めます。

埋め方もわからない場合は

・リボンに開発を追加
　https://office-hack.com/excel/development-tab/

・VBEを開く
　http://plus1excel.web.fc2.com/learning/l301/t101.html

を参照

明示的な実行の操作はありません。
セルの関数式を埋めれば勝手に動作します。

回答No.14

masnoske

回答してから気付きましたが
> マクロを含め各行にあるカタカナと他の文字が混じったテキストの中から一番初めに出てきたカタカナ単語だけを一括複数で抽出できる式を教えて下さい

一番初めに出てきたカタカナ単語だけを「一括複数で抽出」とは，どういう意味でしょうか．
一番初めに出てくるカタカナ単語は 1つですよね．
同様の質問をされているよう（一部の言葉を入れ替えて）なので，適切な補足がなければルール違反として通報します．

補足

セルが多数ありそれぞれのセル中で最初に出てきたカタカナ単語をそれぞれのセルから抜き出したい

回答No.13

masnoske

No.11です．
提示された数式は配列数式だったのですね．
2つの配列数式を使ってできました．
元の式が全角カタカナだけを扱っていたので，この式も同様の扱いとしています．同様に長音と中点も対象外になります．

(1) A列に元データを入力します．

(2) B列に以下の配列数式を入力します．
{=IFERROR(IF(MATCH(1,(CODE(MID(A1,COLUMN($A$7:INDEX($7:$7,LEN(A1))),1))>=9505)*(CODE(MID(A1,COLUMN($A$7:INDEX($7:$7,LEN(A1))),1))<=9590),0)=1,IFERROR(LEFT(A1,MATCH(1,(CODE(MID(A1,COLUMN($A$7:INDEX($7:$7,LEN(A1))),1))<9505)+(CODE(MID(A1,COLUMN($A$7:INDEX($7:$7,LEN(A1))),1))>9590),0)-1),A1),MID(A1,MATCH(1,(CODE(MID(A1,COLUMN($A$7:INDEX($7:$7,LEN(A1))),1))>=9505)*(CODE(MID(A1,COLUMN($A$7:INDEX($7:$7,LEN(A1))),1))<=9590),0),LEN(A1))),"")}

(3) C列に以下の配列数式を入力します．
{=IFERROR(IF(MATCH(1,(CODE(MID(B1,COLUMN($A$7:INDEX($7:$7,LEN(B1))),1))>=9505)*(CODE(MID(B1,COLUMN($A$7:INDEX($7:$7,LEN(B1))),1))<=9590),0)=1,IFERROR(LEFT(B1,MATCH(1,(CODE(MID(B1,COLUMN($A$7:INDEX($7:$7,LEN(B1))),1))<9505)+(CODE(MID(B1,COLUMN($A$7:INDEX($7:$7,LEN(B1))),1))>9590),0)-1),B1),MID(B1,MATCH(1,(CODE(MID(B1,COLUMN($A$7:INDEX($7:$7,LEN(B1))),1))>=9505)*(CODE(MID(B1,COLUMN($A$7:INDEX($7:$7,LEN(B1))),1))<=9590),0),LEN(B1))),"")}

(2)の式で，文字列がカタカナ以外で始まる場合にカタカナより前の文字列を削除しています．
abcアイウエオabcアイウエオ → アイウエオabcアイウエオ

(3)の式で，カタカナ以外の文字より前の文字列を取り出しています．
アイウエオabcアイウエオ → アイウエオ

数式は複雑ですが，やっていることは文字列から最初のカタカナの位置と最初のカタカナ以外の位置を配列数式で求めているだけです．
それぞれの始まりの位置がわかれば，あとはカタカナを切り出すだけです．

最初のカタカナの位置
{=MATCH(1,(CODE(MID(A1,COLUMN($A$8:INDEX($8:$8,LEN(A1))),1))>=9505)*(CODE(MID(A1,COLUMN($A$8:INDEX($8:$8,LEN(A1))),1))<=9590),0)}

最初のカタカナ以外の位置
{=MATCH(1,(CODE(MID(A1,COLUMN($A$8:INDEX($8:$8,LEN(A1))),1))<9505)+(CODE(MID(A1,COLUMN($A$8:INDEX($8:$8,LEN(A1))),1))>9590),0)}

回答No.11

masnoske

この式からだと回答のしようがありません．

(1) 文字列はどの列に入力されているのか．
(2) この式はどのセルに入力されているのか．
(3) CODE(9505)～CODE(9590) で判定しているので，カタカナは全角文字と考えて良いのか．
(4) (3) の範囲だと，長音（ー）や中点（・）は無視してよいのか．
(5) COLUMN($A$1:INDEX($1:$1,LEN(A1))) は何を意味しているのか．
　　$A$1と $1:$1が絶対参照なので，ここにキーとなる情報が入力されているはずだが，それが何なのか式からは判らない．

複雑な数式は 1行で表現せず，複数のセルに分割して参照するようにすれば問題点を見つけやすくなります．

回答No.10

imogasi

関数では、たいへん長い複雑な式になりそうです。
それでVBAでやってみました。
WEB記事を参考にした。
・各セルの、最初の１文字がカタカナかどうかで判定してよいもの、と仮定する。
（簡単にするため。そうでないなら多少プログラム修正が必要）
例データ
A－F列にチェックデータがある可能性ありとする。
123 123 オランダ
as うえの
234 かな カナ
qw 上野 うえの
トウキョウ 345 とうきょう
ー 目黒 メグロ　（－は空白セルを示す）
結果　私の場合　G列
オランダ
-
カナ
-
トウキョウ
-
＝＝＝＝＝＝
test01の方を実行してください。
標準モジュールに
Function mojishu(rng As Range)
Dim msg As String

If rng = StrConv(rng, vbHiragana) Then
msg = False
Else
msg = False
If rng = StrConv(rng, vbKatakana) Then
msg = True
Else
msg = False
End If
End If
mojishu = msg
End Function
Sub test01()
lr = 10

For i = 1 To lr
For j = 1 To 10
If mojishu(Cells(i, j)) = True Then
Cells(i, "G") = Cells(i, j)
Exit For
End If
Next j
Next i
End Sub
小数のデータでしかテストしてないので、もし多様なデータでは、不都合な例が出れば、ご免なさい。

回答No.9

HohoPapa

何度も差し替えごめんなさい。

長音と、ヷ、ヸ、ヹ、ヺ
を考慮していなかったです。
また、成り行き上、「・」もカタカナとして扱っています。

Function GetFastwordKanaY(MyText As String) As String

　Dim wkText As String
　Dim TextLen As Long
　Dim i As Long
　Dim MySwitch As Boolean
　Dim S As Long
　Dim E As Long

　S = 0
　E = 0
　wkText = MyText
　TextLen = Len(wkText)
　MySwitch = False

　For i = 1 To TextLen
　　If ( _
　　 (MySwitch = False) And _
　　 (((AscW(Mid(wkText, i, 1)) >= 12450) And (AscW(Mid(wkText, i, 1)) <= 12540)) Or _
　　 ((Asc(Mid(wkText, i, 1)) >= 166) And (Asc(Mid(wkText, i, 1)) <= 223))) _
　　 ) Then
　　　S = i
　　　MySwitch = True
　　ElseIf ( _
　　 (MySwitch = True) And _
　　　　(((AscW(Mid(wkText, i, 1)) < 12450) And ((AscW(Mid(wkText, i, 1)) > 0))) Or _
　　　　(AscW(Mid(wkText, i, 1)) > 12540)) _
　　 ) Then

　　　E = i - 1
　　　Exit For
　　End If
　　If E = 0 Then
　　　E = TextLen
　　End If
　Next i

　If S > 0 Then
　　GetFastwordKanaY = Mid(MyText, S, E - S + 1)
　Else
　　GetFastwordKanaY = ""
　End If

End Function

補足

マクロの実行の仕方がわかりません

回答No.8

SI299792

どうやら、このサイトでは、勝手に半角が全角にされてしまうみたいです。
このプログラム、そのまま来ぴパしても動きません。
上げておきます。ダウンロードして下さい。

https://drive.google.com/file/d/1agcKQI3fkKwKFJln4W-mWWQLBd5WtcBi/view?usp=sharing

回答No.7

SI299792

どうやら、「ヲ」は勝手に全角にされるみたいです。
半角に直して下さい。

回答No.6

SI299792

超手抜きです。ユーザー定義関数にしました。
使い方は
=FirstKatakana(A1)
です。

Option Explicit
'
Function FirstKatakana(Expression As String) As String
　　Dim RegExp As Object
'
　　Set RegExp = CreateObject("VBScript.RegExp")
　　RegExp.Pattern = "[ヲ-゜,ァ-ヶ]+"
　　Set RegExp = RegExp.Execute(Expression)
'
　　If RegExp.Count > 0 Then
　　　　FirstKatakana = RegExp(0)
　　End If
End Function

回答No.5

HohoPapa

>ちょっと手抜きですが
手を抜かず、
>単語に半角カタカナと全角カタカナが混じると耐えられません。
これに耐えられるようにしてみました。

動作確認は手抜きしていますので
もしよかったら、
しっかりテストし、使えるようなら使ってください。

Function GetFastwordKanaX(MyText As String) As String

　Dim wkText As String
　Dim TextLen As Long
　Dim i As Long
　Dim MySwitch As Boolean
　Dim S As Long
　Dim E As Long

　S = 0
　E = 0
　wkText = MyText
　TextLen = Len(wkText)
　MySwitch = False

　For i = 1 To TextLen
　　If ( _
　　 (MySwitch = False) And _
　　 (((AscW(Mid(wkText, i, 1)) >= 12450) And (AscW(Mid(wkText, i, 1)) <= 12534)) Or _
　　 ((Asc(Mid(wkText, i, 1)) >= 166) And (Asc(Mid(wkText, i, 1)) <= 223))) _
　　 ) Then
　　　S = i
　　　MySwitch = True
　　ElseIf ( _
　　 (MySwitch = True) And _
　　　　(((AscW(Mid(wkText, i, 1)) < 12450) And ((AscW(Mid(wkText, i, 1)) > 0))) Or _
　　　　(AscW(Mid(wkText, i, 1)) > 12534)) _
　　 ) Then

　　　E = i - 1
　　　Exit For
　　End If
　　If E = 0 Then
　　　E = TextLen
　　End If
　Next i

　If S > 0 Then
　　GetFastwordKanaX = Mid(MyText, S, E - S + 1)
　Else
　　GetFastwordKanaX = ""
　End If

End Function

回答No.4

HohoPapa

ちょっと手抜きですが
以下なら、全角、半角それぞれに濁音、半濁音が混じっても大丈夫です。
ただし、
（常識的にはないと思いますが）
単語に半角カタカナと全角カタカナが混じると耐えられません。

Function GetFastwordKana0(MyText As String) As String
　GetFastwordKana0 = GetFastwordKana1(MyText) & GetFastwordKana2(MyText)
End Function

Function GetFastwordKana1(MyText As String) As String

　Dim wkText As String
　Dim TextLen As Long
　Dim i As Long
　Dim MySwitch As Boolean
　Dim S As Long
　Dim E As Long

　S = 0
　E = 0
　wkText = MyText
　TextLen = Len(wkText)
　MySwitch = False

　For i = 1 To TextLen
　　If ( _
　　 (MySwitch = False) And _
　　 ((AscW(Mid(wkText, i, 1)) >= 12450) And (AscW(Mid(wkText, i, 1)) <= 12534)) _
　　 ) Then
　　　S = i
　　　MySwitch = True
　　ElseIf ( _
　　 (MySwitch = True) And _
　　 ((AscW(Mid(wkText, i, 1)) < 12450) Or (AscW(Mid(wkText, i, 1)) > 12534)) _
　　 ) Then

　　　E = i - 1
　　　Exit For
　　End If
　　If E = 0 Then
　　　E = TextLen
　　End If
　Next i

　If S > 0 Then
　　GetFastwordKana1 = Mid(MyText, S, E - S + 1)
　Else
　　GetFastwordKana1 = ""
　End If

End Function

Function GetFastwordKana2(MyText As String) As String

　Dim wkText As String
　Dim TextLen As Long
　Dim i As Long
　Dim MySwitch As Boolean
　Dim S As Long
　Dim E As Long

　S = 0
　E = 0
　wkText = MyText
　TextLen = Len(wkText)
　MySwitch = False

　For i = 1 To TextLen
　　If ((MySwitch = False) And _
　　　(Asc(Mid(wkText, i, 1)) >= 166) And _
　　　(Asc(Mid(wkText, i, 1)) <= 223)) Then
　　　S = i
　　　MySwitch = True
　　ElseIf ((MySwitch = True) And _
　　　(Asc(Mid(wkText, i, 1)) < 166) Or _
　　　(Asc(Mid(wkText, i, 1)) > 223)) Then
　　　E = i - 1
　　　Exit For
　　End If
　　If E = 0 Then
　　　E = TextLen
　　End If
　Next i

　If S > 0 Then
　　GetFastwordKana2 = Mid(MyText, S, E - S + 1)
　Else
　　GetFastwordKana2 = ""
　End If

End Function