[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『文字抽出』(daddy)
B列にある文字列から特定文字(半角カタカナ)を抽出してA列に表示したい。
A B イ 1.イ ロ 2.ロ、3.ハ、4.ニ ハ 5.ホ ニ 6.ヘ、7.ト ホ ヘ ト
※半角カタカナは、一文字ではなく20字程度まであり(例示は一文字ですが)−追記
・文字列は半角の数字カタカナ、区切り記号混じり
・文字列の区切りに「,」「、」「空白」の何れか1種あり
・一行の文字列は特定文字を最大10個程度まで含む
予め10行おきにFIND関数を使って抽出することはできますが、
B列の行数が多くて大変なため、空白行なしで抽出したいです。
よろしくお願いします。
< 使用 Excel:Excel2010、使用 OS:Windows7 >
vba案ですが…実行するとB列中の半角文字をA列に順に転記します。 Sub sample() Dim tbl, f, i As Long, ii As Long, r As Long tbl = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row).Value Columns("A").ClearContents For i = 1 To UBound(tbl) f = Filter(Evaluate("transpose(substitute(small(find(char(row(166:223)),""" & tbl(i, 1) & _ """&char(row(166:223))),row(1:58))," & Len(tbl(i, 1)) + 1 & ",char(10)))"), vbLf, 0) For ii = 0 To UBound(f) r = r + 1 Range("A" & r).Value = Mid$(tbl(i, 1), f(ii), 1) Next ii Next i End Sub (Jera) 2014/04/09(水) 15:49
断りを入れずに心苦しいのですが、関数式でお願いできないでしょうか?
VBAは、自分にはまだまだハードルが高いもので..
本当に申訳ありません。
(daddy) 2014/04/09(水) 17:35
関数で、となると私には難しいです。 作業列をたくさん使用すればできなくもないような気もしますが、他の先生にお任せしたいと思います。 参考までにお尋ねしますがB列のデータはどのくらいあるのですか? それと
>・文字列は半角の数字カタカナ、区切り記号混じり >・文字列の区切りに「,」「、」「空白」の何れか1種あり >・一行の文字列は特定文字を最大10個程度まで含む
例示では「.」の後に必ず半角カタカナ一文字がありますね。 これは絶対のルールですか? (Jera) 2014/04/09(水) 1:19
ダラダラ案
A1 =IFERROR(TRIM(SUBSTITUTE(LOOKUP(1,0/FIND("、"&ROW(A1)&".",SUBSTITUTE(SUBSTITUTE("、"&B$1:B$100," ","、"),",","、")), MID(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE("、"&B$1:B$100," ","、"),",","、"),"、",REPT(" ",50)), FIND(" "&ROW(A1)&".",SUBSTITUTE(SUBSTITUTE(SUBSTITUTE("、"&B$1:B$100," ","、"),",","、"),"、",REPT(" ",50))),50))," "&ROW(A1)&".","")),"")
下へコピー。 (GobGob) 2014/04/10(木) 08:34
・B列は50行程度まで
・B列の文字列の例
9.パンダ 5.ウイロ、14.ハンガー、8.インパクト
>例示では「.」の後に必ず半角カタカナ一文字がありますね。 →区切り記号の後には半角カタカナが始まります。
(GobGob)さん
今、Excel2010の環境にないため、IFERRORの部分のみ削除して試しましたが、
上記例では「#N/A」となります。
確認方法の問題かも知れませんので、もう少し時間ください。
(daddy) 2014/04/10(木) 11:51
A B ハ 9.パンダ ゚ 5.ウイロ、14.ハンガー、8.インパクト ン タ ゙ ウ イ ロ (略)
最初に提示したように、半角カタカナ部分のみ取り出したいです。
(具体例)
パンダ
ウイロ
ハンガー
インパクト
(daddy) 2014/04/11(金) 10:57
《今、Excel2010の環境にないため、IFERRORの部分のみ削除して試しましたが、
上記例では「#N/A」となります。》
↑ピリオドや読点が半角だったり全角だったりしていませんか?
(とらら) 2014/04/11(金) 11:49
こうかな? Sub sample() Dim tbl, f, i As Long, ii As Long, j As Long, r As Long Dim res, s As String, d As String, delim As String tbl = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row).Value Columns("A").ClearContents For i = 1 To UBound(tbl) For ii = 1 To Len(tbl(i, 1)) s = Mid(tbl(i, 1), ii, 1) f = Filter(Evaluate("transpose(if(iserror(find(char(row(166:223)),""" & s & """))," & _ "char(10),find(char(row(166:223)),""" & s & """)))"), vbLf, 0) If UBound(f) = 0 Then If (Len(d) = 0) + (delim = ",") Then j = ii delim = IIf(j = ii, "", ",") d = d & delim & s j = j + 1 End If Next ii If Len(d) Then res = Split(d, ",") Range("A" & r + 1).Resize(UBound(res) + 1).Value = Application.Transpose(res) r = Range("A" & Rows.Count).End(xlUp).Row End If j = 0: d = "" Next i End Sub (Jera) 2014/04/11(金) 14:48
別案で
Sub test() Dim a, b, e, m As Object, n As Long a = Range("b1", Range("b" & Rows.Count).End(xlUp)).Value ReDim b(1 To 10000, 1 To 1) With CreateObject("VBScript.RegExp") .Global = True .Pattern = "[\uFF61-\uFF9F]" For Each e In a For Each m In .Execute(e) n = n + 1 b(n, 1) = m.Value Next Next End With [a1].Resize(n).Value = b End Sub (seiya) 2014/04/12(土) 06:33
seiyaさん、一文字ずつ別セルではなく、単語単位みたいですよ? しかし、正規表現ならもっとあっさりしたコードになるんだろうなぁとは思っていました。 これを機にメタ文字の世界も少しずつ勉強しようと思います。 (Jera) 2014/04/13(日) 00:40
最初の例示でみんな勘違いしたようです。 今回のケースでは正規表現が適していそうですね。
パターンは "([\uFF61-\uFF9F]+)" かな。 (Mook) 2014/04/13(日) 00:58
.Pttern = "[\uFF61-\uFF9F]+" に変更。 ()は不要。 (seiya) 2014/04/13(日) 05:05
(GobGob)さん
3行の式を一つにしてコピペした結果です。
A B
9.パンダ 5.ウイロ、14.ハンガー、8.インパクト
ウイロ
何か妙?ですよね?
式を一行にする時の不手際かと思い、何回も見直しましたが..
(seiya)さん、(Jera)さん、(Mook)さん
例ではうまくいきました!
が、実際のは「全角カタカナ」が混じっていて..
半角、全角に対応可能でしょうか?
(daddy) 2014/04/13(日) 13:48
.Pattern = "[\u30A1-\u30FA\uFF61-\uFF9F]+"
でどうでしょうか。
(五線譜) 2014/04/13(日) 14:20
A B ウイロ 5.ウイロ、14.ハンガー、8.インパクト ハンガー 1.パワーチャージ、4.バイタル、7.ロープーウェー インパクト パワ チャ ジ バイタル ロ プ ウェ
・「−」(全角長音記号?)があるとダメなんでしょうか?
・B列が一行のみだとエラーとなります
(daddy) 2014/04/13(日) 16:39
.Pattern = "[\uFF61-\uFF9F\u30A1-\u30F6ー]+" に変更してみて? (seiya) 2014/04/13(日) 16:48
>・B列が一行のみだとエラーとなります
Sub test() Dim a, r As Range, m As Object, n As Long ReDim a(1 To 10000, 1 To 1) With CreateObject("VBScript.RegExp") .Global = True .Pattern = "[\uFF61-\uFF9F\u30A1-\u30F6ー]+" For Each r In Range("b1", Range("b" & Rows.Count).End(xlUp)) For Each m In .Execute(r.Value) n = n + 1 a(n, 1) = m.Value Next Next End With [a1].Resize(n).Value = a End Sub (seiya) 2014/04/13(日) 16:58
実際のでもうまくいくようです。
式の意味はほとんどわかりませんが(苦笑)、使わせていただきます。
関数では大変な式になりそうですし、それぞれ得手不得手があるということで
割り切りたいと思います。
(VBAも複雑な関数式も自分にとってはまだまだ“敷居が高い”という意味です)
回答いただいた方々、本当にありがとうございました。
(daddy) 2014/04/13(日) 21:29
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.