[[20140409130308]] 『文字抽出』(daddy) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『文字抽出』(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


(Jera)さん
わからないなりに、VBAを実行してみました。
↓結果
 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.