[[20140905120038]] 『条件抽出』(daddy) ページの最後に飛ぶ

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

 

『条件抽出』(daddy)

質問)
例表のB,C列から下記条件に従いD列に表示する

例表)

 A	B	C	    D		 G	 H
 名称	記号	メモ	    抽出	          記号1	 記号2
 ア	a	***a***	    a		 a	 j
 イ	j	*b**c*	    j-b-c	          b	 k
 ウ	b	*******	    b		 c	
 エ	h	***	    --				
 オ		*****	    --				
 カ	k	******	    k				

条件)
1.B列(記号)の中でG列(記号1)に一致するのがあれば、それを表示する
 (ア、ウの例)
2.B列の中でH列(記号2)に一致するのがある場合は以下とする
 ・C列の中にG列に一致するのがある場合は、それと共に表示する
  (イの例)
 ・C列の中にG列に一致するのがない場合は、B列のみ表示する
  (カの例)
3.上記1.2.に該当しない場合は「--」表示する(エ、オの例)
 ※B列を主体に判断する
 (仮にB列が空欄でC列にG列に一致するのがあっても「--」表示とする)
説明)
・A列:カタカナ(大小)あるいは英数字(小)、重複なし
・B,G,H列:英数字(小2桁) ※B列のみ空欄あり、重複あり
・C列:あらゆる文字種、記号を含む
・A列は通常1万行まで、最大2万行想定

できれば関数式で、効率的でないようであればマクロでも。
ただし、マクロであれば初歩的な説明をお願いしたいです。

よろしくお願いします。

< 使用 Excel:Excel2010、使用 OS:Windows7 >


 これね。作業列がないとたぶん数式無理だと思うよ。(イの例)
 G、H列もたぶんすごい量なんでしょ?データ。

 VBAでやったほうがいいと思う。
(GobGob) 2014/09/05(金) 13:11

 これイってB列jでH列kだから、条件3じゃないのん??
(稲葉) 2014/09/05(金) 13:26

 あ、もしかして、GH列って何かの表で、行単位で判断するわけじゃないってこと??
(稲葉) 2014/09/05(金) 13:27

補足します..
・G,Hはマッチング用の「表」と考えてください
・G,H(Bでもありますが)の文字種?は合わせて30種類までを想定
・Cの中でGに“複数”一致するケースは5個ぐらいまでと想定
・必要なら作業列OKです

よろしいでしょうか?

(daddy) 2014/09/05(金) 13:54


 関数は私には無理でした!
 提示された例の範囲なら結果通りです。
 ご確認ください。
    Sub dddd()
        Dim tbl
        Dim G列範囲 As String, H列範囲 As String
        Dim G列文字 As String, H列文字 As String
        With Sheets("Sheet1")
            tbl = .Range("B2", Range("C" & .Rows.Count).End(xlUp)).Value
            G列範囲 = .Name & "!" & .Range("G2", .Cells(.Rows.Count, "G").End(xlUp)).Address(0, 0)
            H列範囲 = .Name & "!" & .Range("H2", .Cells(.Rows.Count, "H").End(xlUp)).Address(0, 0)
            G列文字 = Join(Filter(Evaluate("TRANSPOSE(IF(" & G列範囲 & "<>""""," & G列範囲 & ",""-""))"), "-", False))
            H列文字 = Join(Filter(Evaluate("TRANSPOSE(IF(" & H列範囲 & "<>""""," & H列範囲 & ",""-""))"), "-", False))
            Dim B列 As String
            Dim C列 As String
            Dim i As Long
            Dim Result
            ReDim Result(1 To UBound(tbl, 1))
            For i = 1 To UBound(tbl, 1)
                B列 = tbl(i, 1)
                C列 = tbl(i, 2)
                Select Case True
                    Case B列 = ""                   '条件3 B列が空白なら条件2が当てはまっても"--"
                        Result(i) = "--"
                    Case InStr(1, G列文字, B列) > 0 '条件1 B列の文字がG列に有れば、B列の文字を表示
                        Result(i) = B列
                    Case InStr(1, H列文字, B列) > 0 '条件2 B列の文字がH列に有れば、
                        On Error Resume Next
                                                    '条件2-1 C列の文字列の中に、G列の文字があればJoinで繋ぐ
                        Result(i) = Join(Filter(Evaluate("TRANSPOSE(IF(ROW(1:" & Range(G列範囲).Rows.Count & "),IFERROR(MID(""" & C列 & """,FIND(" & G列範囲 & ",""" & C列 & """),1),""-"")))"), "-", False), "-")
                                                    '条件2-2 C列の文字列の中に、G列の文字がなければB列のみ表示
                        Result(i) = IIf(Result(i) = "", B列, B列 & "-" & Result(i))
                        On Error GoTo 0
                    Case Else                       '条件3 条件1・2に該当しない場合
                        Result(i) = "--"
                End Select
            Next i
            .Range("D2").Resize(UBound(Result)).Value = Application.Transpose(Result)
        End With
    End Sub

 条件の記述追記(1558)
(稲葉) 2014/09/05(金) 15:54

作業列:KとJ

K2=IFERROR(MID($C2,AGGREGATE(15,6,SEARCH($G$2:$G$4,$C2),COLUMN(A$1)),1),"")
列Mまで右へコピー、下へコピー

J2=IFERROR(CHOOSE(LEN(K2&L2&M2),"-"&K2,"-"&K2&"-"&L2,"-"&K2&"-"&L2&M2),"")
下へコピー

D2=IF(B2="","--",IF(IFERROR(LOOKUP(2^15,SEARCH($G$2:$G$4,B2),$G$2:$G$4),"")=B2,B2,IF(IFERROR(LOOKUP(2^15,SEARCH($H$2:$H$3,B2),$H$2:$H$3),"")=B2,B2&J2,"--")))
下へコピー

一応サンプルデータの範囲で作成しています
(wisemac21) 2014/09/06(土) 00:44


確認遅くなりました、お許しください。

稲葉様
With Sheets("Sheet1") の箇所でインデックスエラーになってしまいました。
「sheet1」を実際に使用しているシート名にしてみましたが、同じでした。
マクロ初心者以前の者ですが、どうしたらいいでしょうか?

wisemac21様
例題ではうまくいきましたが、a,bをa1,b1に変えると?です。(下イ)

 名称	記号	メモ	   抽出			記号1	記号2
 ア	a1	***a***	   a1			a1	j
 イ	j	*b1**c1*   j-b-c		b1	k
 ウ	b1	******	   b1			c1	
 エ	h	***	   --				
 オ		****	   --				
 カ	k	*****	   k				

AGGREGATE は初見の関数で調べてみましたが、よくわかりません。

ご教授お願いします。

(daddy) 2014/09/07(日) 14:45


G列H列の記号の文字数は2桁ならすべて2桁ですか、それとも1桁と2桁が混在しますか。
(wisemac21) 2014/09/07(日) 16:02

お世話になります。
B,G,Hは、「半角2桁か全角1桁」です。
(最初の説明と異なり、すみません)

文字種に制限あるようでしたら、その旨指示ください。

よろしくお願いします。
(daddy) 2014/09/07(日) 18:35


稲葉様
先のインデックスエラーの件、撤回します。
例示ではうまくいきました! こちらの操作ミスでした..
不手際お詫びします m(_ _)m

ただ、a,bをa1,b1に変えると上記 wisemac21 様の式と同様になります。

(daddy) 2014/09/07(日) 21:00


作業列として
O2 =IFERROR(MID($C2,AGGREGATE(15,6,SEARCH($G$2:$G$4,$C2),COLUMN(A$1)),2),"")
右へコピーQ2まで、下へこぴー
(2014/9/8 G列の範囲を修正)

K2 =IF(LENB(O2)=3,LEFT(O2),O2)
右へコピーM2まで、下へコピー

J2 =IFERROR(CHOOSE(LENB(K2&L2&M2)/2,"-"&K2,"-"&K2&"-"&L2,"-"&L2&"-"&L2&"-"&M2),"")
下へコピー

D2は前回と同じです

(wisemac21) 2014/09/07(日) 21:22


 名称	記号	メモ	   抽出			記号1	記号2
 ア	a1	***a***	   a1			a1	j
 イ	j	*b1**c1*   j-b1-b1-c1		b1	k
 ウ	b1	******	   b1			c1	
 エ	h	***	   --				
 オ		****	   --				
 カ	k	*****	   k-**	

微妙に??なんですが..何かこちらの不手際があるのでしょうか?

(daddy) 2014/09/07(日) 22:25


サンプルデータで正しく表示されています。

セルO2の数式が正しく右、下へコピーされていますか
(wisemac21) 2014/09/07(日) 22:41


 >Result(i) = Join(Filter(Evaluate("TRANSPOSE(IF(ROW(1:" & Range(G列範囲).Rows.Count & "),IFERROR(MID(""" & C列 & """,FIND(" & G列範囲 & ",""" & C列 & """),1),""-"")))"), "-", False), "-")
 この1行を

 Result(i) = Join(Filter(Evaluate("TRANSPOSE(IF(ROW(1:" & Range(G列範囲).Rows.Count & "),IFERROR(MID(""" & C列 & """,FIND(" & G列範囲 & ",""" & C列 & """),LEN(" & G列範囲 & ")),""-"")))"), "-", False), "-")
 こちらに置き換えてください。
(稲葉) 2014/09/08(月) 09:05

ありがとうございます。 
モタモタして衝突しちゃいました _ _; 先に(wisemac21)様へ
すぐ見直しできる環境になく(パソコンが旧い)レスポンス悪くなります..お許しください。 

自分なりに初見の関数式を含めご提案式を考えていてお尋ねします。
・AGGREGATE(15,6,SEARCH($G$2:$G$5,$C2)の「G$2:$G$5」は「G$2:$G$4」ではないのでしょうか?
・O,K列以降右への作業列はG列の行数に応じて必要になる..との認識でよろしいでしょうか?

(稲葉)様、もうしばらく確認時間ください..

よろしくお願いします。
(daddy) 2014/09/08(月) 10:15


>・AGGREGATE(15,6,SEARCH($G$2:$G$5,$C2)の「G$2:$G$5」は「G$2:$G$4」ではないのでしょうか?
その通りです。G列のデータ範囲にしてください。テストデータのときの範囲をそのままにしていました。

>・O,K列以降右への作業列はG列の行数に応じて必要になる..との認識でよろしいでしょうか?
必要な列数はC列の文字に含まれるG列の検索文字の数になります。
サンプルデータではセルC3が2個だったので、余裕を見て3列にしていますが必要に応じて作業列の列数は調整してください

(wisemac21) 2014/09/08(月) 11:38


(wisemac21)様
適当に例題を弄ってみた結果です。
 A	B	C	      D	             G	 H         J
 ア	a1	***a***	      a1	     a1	 j1        
 イ	j1	*b1*,*c1*d1   j1-c1-c1-d1    b1  k1        -c1-c1-d1
 ウ	b1	******	      b1	     c1	
 エ	h1	***	      --	     d1	
 オ		****	      --				
 カ	k1	***d1**	      k1-d1	                   -d1

なんなんでしょう..J列がよくわかりません(涙)

(稲葉)様
上例も問題ありませんでした!
が、実データでは「C列の型が一致しない」とのエラーメッセージが出ます(涙)
どこが原因か調べようにも数千行あるので..トホホです。

試しにC列のある行以下を削除したところ、問題ありません。(空欄行もOKでした)
どのように原因を調べたらいいでしょうか?

(daddy) 2014/09/08(月) 23:06


J列の数式に一部誤りがありました。

J2 =IFERROR(CHOOSE(LENB(K2&L2&M2)/2,"-"&K2,"-"&K2&"-"&L2,"-"&K2&"-"&L2&"-"&M2),"")
CHOOSE関数の4番目の引数の
"-"&K2&"-"&L2&"-"&M2 が
"-"&L2&"-"&L2&"-"&M2 となっていました。
失礼しました。

(wisemac21) 2014/09/09(火) 00:22


 >が、実データでは「C列の型が一致しない」とのエラーメッセージが出ます(涙) 
 C列中のどこかにエラー値ありませんか?
 #N/A #REF! #NAME? #VALUE!
http://www.relief.jp/itnote/archives/000012.php

 調べ方は、止まったところで代入される値「tbl(i, 2)」の「tbl」にカーソルを合わせると、
 ポップアップで値が出ると思います。
 また「i」のところにカーソルを合わせ、その数値+1がC列の行番号です。

 逆にお聞きしますが、C列がエラーの場合はどのように処理しますか?

(稲葉) 2014/09/09(火) 08:51


いろいろとありがとうございます。 
確認は本日の夜以降になります、お許しください。

C列には数式は使用しておらず、原則“手入力”なのでエラー値は考えにくいのですが、
他ブックから一括入力(値ペースト)をする場合もあり、ひょっとすると紛れ込んで
いるかも知れませんね..
C列の特定行で何らかの原因で処理が止まってしまう場合は「?」と表示し、以降の行は
そのまま処理を継続できると嬉しいのですが..
(後で確認できるように、他の表示と区別したいです)

よろしくお願いします。

(daddy) 2014/09/09(火) 11:27


 > For i = 1 To UBound(tbl, 1)
 から
 >Next i
 の間を以下に置き換えてください
            For i = 1 To UBound(tbl, 1)
                If IsError(tbl(i, 2)) Then
                    Result(i) = "?"
                Else
                    B列 = tbl(i, 1)
                    C列 = tbl(i, 2)
                    Select Case True
                        Case B列 = ""                   '条件3 B列が空白なら条件2が当てはまっても"--"
                            Result(i) = "--"
                        Case InStr(1, G列文字, B列) > 0 '条件1 B列の文字がG列に有れば、B列の文字を表示
                            Result(i) = B列
                        Case InStr(1, H列文字, B列) > 0 '条件2 B列の文字がH列に有れば、
                            On Error Resume Next
                                                        '条件2-1 C列の文字列の中に、G列の文字があればJoinで繋ぐ
                            Result(i) = Join(Filter(Evaluate("TRANSPOSE(IF(ROW(1:" & Range(G列範囲).Rows.Count & "),IFERROR(MID(""" & C列 & """,FIND(" & G列範囲 & ",""" & C列 & """),LEN(" & G列範囲 & ")),""-"")))"), "-", False), "-")
                                                        '条件2-2 C列の文字列の中に、G列の文字がなければB列のみ表示
                            Result(i) = IIf(Result(i) = "", B列, B列 & "-" & Result(i))
                            On Error GoTo 0
                        Case Else                       '条件3 条件1・2に該当しない場合
                            Result(i) = "--"
                    End Select
                End If
            Next i
(稲葉) 2014/09/09(火) 11:52

(wisemac21)様の式も、(稲葉)様のマクロもテストでは問題ありませんでした!

が、実データでは式の方は一部妙?な箇所(行)があります..
実データ用にセル範囲は修正しているつもりですが..

質問ですが、英字の大文字小文字は「区別なし」でしょうか?
どうも、それが原因かと..(全て調べきっていませんが)

今日のところは途中経過報告とさせていただきます..

(daddy) 2014/09/10(水) 23:09



 Instr関数もFind関数も大小区別します
 SEARCH関数は区別しない代わりにワイルドカードが使えます
 もし私のものとwisemac21さんのものが同一であれば、大小は関係ありません
(稲葉) 2014/09/11(木) 00:13

ありがとうございます。

 >SEARCH関数は区別しない代わりにワイルドカードが使えます

→ちょっと考えてみます(自信ないですが..苦笑)

 >もし私のものとwisemac21さんのものが同一であれば、大小は関係ありません

→現時点で、マクロは問題ありません

関数式での実データ不具合事例
・C列に「Ac」が1個ある場合にD列に「-Ac-Ac」と2個表示されます
・G列には「Ac」と「ac」があります

(daddy) 2014/09/11(木) 09:28


SEARCH関数を使っているので、英文字列のUPPER,PROPER,LOWERの判定はできません。
FIND関数を使うとなると難しいですね。
(wisemac21) 2014/09/11(木) 12:32

 これもしかして
 C列に??Ac??Ac??
 ってあって、

 G列にAc
 があったら

 出力は
 B列-Ac-Ac
 にしなくちゃだめ?

 その場合また別途考えないと・・・
(稲葉) 2014/09/11(木) 12:42

ありがとうございます。

 >SEARCH関数を使っているので、英文字列のUPPER,PROPER,LOWERの判定はできません。 
 >FIND関数を使うとなると難しいですね。

う〜ん、実はFIND関数を試すつもりでしたが(笑)何故ダメなんでしょうか?

C列にG列に該当するのが複数あることはない(ハズ?)ので、これは考慮外で結構です。
(実際には入力ミスがありそうですが..苦笑)

(daddy) 2014/09/11(木) 13:41


 単純に作業列をG列分準備した揮発性関数も(Transpose以外の)配列関数も使わない方法で・・・
 G列は50行くらいでしたっけ?
 J1:BG1を選択して(G列の50行分)
 =TRANSPOSE(G2:G51)
 Ctrl+Shift+Enter

 J2=IF(J$1=0,"",IFERROR("-"&MID($C2,FIND(J$1,$C2),LEN(J$1)),""))
 BG2までコピー

 I2=J2&K2&L2&M2&N2&O2&P2&Q2&R2&S2&T2&U2&V2&W2&X2&Y2&Z2&AA2&AB2&AC2&AD2&AE2&AF2&AG2&AH2&AI2&AJ2&AK2&AL2&AM2&AN2&AO2&AP2&AQ2&AR2&AS2&AT2&AU2&AV2&AW2&AX2&AY2&AZ2&BA2&BB2&BC2&BD2&BE2&BF2&BG2

 で、これ毎回作れないので、適当なシートで
 A2=A1&"&"&ADDRESS(2,ROW(A10),4)
 必要な列分下方向にコピー
 一番下のデータを値として貼り付けし、最初の「&」を「=」に置き換える

 D2=IF(ISERROR(C2),"?",IF(B2="","--",IFERROR(VLOOKUP(B2,G:G,1,0),IFERROR(VLOOKUP(B2,H:H,1,0)&I2,"--"))))

 マクロを数式に置き換えるとこんな感じになりますが、
 10000以上ならマクロのほうがいいとおもうなぁ・・・
(稲葉) 2014/09/11(木) 18:31

削除
(wisemac21) 2014/09/11(木) 20:59

 こういうこと?

 Sub test()
    Dim ColG As String, ColH As String, a, i As Long, m As Object
    With Range("g1").CurrentRegion
        ColG = Join(Application.Transpose(.Columns(1).Offset(1).SpecialCells(2)), "|")
        ColH = Join(Application.Transpose(.Columns(2).Offset(1).SpecialCells(2)), "|")
    End With
    With Cells(1).CurrentRegion
        .Offset(1).Columns(4).ClearContents
        a = .Value
        With CreateObject("VBScript.RegExp")
            .Global = True: .IgnoreCase = True
            For i = 2 To UBound(a, 1)
                .Pattern = ColG
                If .test(a(i, 2)) Then a(i, 4) = a(i, 2)
                .Pattern = ColH
                If .test(a(i, 2)) Then
                    .Pattern = ColG
                    If .test(a(i, 3)) Then
                        a(i, 4) = a(i, 4) & IIf(a(i, 4) <> "", "-", "") & a(i, 2)
                        For Each m In .Execute(a(i, 3))
                            a(i, 4) = a(i, 4) & IIf(a(i, 4) <> "", "-", "") & m.Value
                        Next
                    Else
                        a(i, 4) = a(i, 2)
                    End If
                End If
                If a(i, 4) = "" Then a(i, 4) = "--"
            Next
        End With
        .Value = a
    End With
End Sub
(seiya) 2014/09/12(金) 09:37

 seiyaさん
 正規表現の選択一致パターン気付きませんでした・・・
 練習だからとEvaluateにこだわってちゃだめですね。

 一部C列がエラー値だと止まってしまうようです。
 >If .test(a(i, 3)) Then

(稲葉) 2014/09/12(金) 12:56


皆さま、ありがとうございます! 返信遅れてすみません。

白状します..11日の稲葉さんの式と(seiya)さんのやりとりにはオツムが
ついていけません(涙)

で、(wisemac21)さんの式にはいろいろヒントをもらえましたし、
こちらのひと工夫でいろいろ応用させていただこうかと思っています。

実データは稲葉さんのマクロを使わせていただこうかと思います。
ただ、マクロは(seiya)さんのと同じく未だまだ“未消化”で、
正直不安はありますが“習うより慣れよ”の精神で、チャレンジしたいと思っています。

これからもよろしくお願いします。

(daddy) 2014/09/14(日) 22:36


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.