excelで指定文字間の繰り返し抽出の方法

質問

excelの文字列でる特定の文字と文字（この場合、カンマ「,」）の間に存在する
文字だけを抽出する方法が分かりません。

シートAとシートBが存在します。

シートA
セルA セルB
売上番号　商品名
0001 A,B,C,D,E
0002 A,B,E
0003 AAA
0004 ブランク=（NULL）
0005 xyz
　：

シートB
セルA セルB
商品番号　商品名
0001 A
0002 B
0003 C
0004 AAA
0005 E
0006 BBB
0007 D
　：

そこで、シートAのセルBにある商品名が、シートBのセルBの商品名に
存在するかを検索し、すべて存在したらシートAの該当する行のセルC
に、”〇”か”×”を設定したい。

関数での方法があればどなたか教えてください。
関数が無理でしたら、マクロ、vbaなどで教えてください。
よろしくお願いします。

回答No.4

eden3616 · ベストアンサー

度々失礼します。
別の方法（コードの内容的に）になります。

最下のVBAコードと差し換えてください。

セルC2に以下の数式を貼り付けて下へオートフィルしてください。
　　=集計(シートB!A$2:B$10,A2,B2,",",1)
（A$2/B$10は対象のセル範囲の開始セル/終了セルに合わせて変更ください）

様式は以下のようになります
=集計(検索範囲,対象商品番号,対象商品名,区切り文字,全角区別)
・検索範囲：シートB!A$2:B$10 ・・・ 検索対象のセル範囲を指定
・対象商品番号：A2 ・・・ 対象の商品番号セルを指定
・対象商品名：B2 ・・・ 対象の商品名セルを指定
・区切り文字：","　・・・ ""で括って指定
・全角区別：1　・・・　大文字小文字を区別する場合は1、しない場合は0

(注意)
検索範囲でこれまでのように「シートB!A:B」でも動作しますが、処理時間がかかります。
実際のデータ範囲を上記例のように指定したほうが早く動作致します。
（オートフィルでセル範囲が移動しないように行番号に$を付けてください）

また処理時間短縮のため検索範囲のうち、A列が空白になるまでを判定する範囲としています。
検索範囲が「A$2:B$10」の場合、セルA5が空欄であれば「A$2:B$4」までの範囲で判定することになります。
漏れなくすべての範囲をチェックする場合はコード内の末尾に「 '★」が付いている行を削除してください。

■VBAコード

Function 集計(myRng As Range, myTar1 As Range, myTar2 As Range, Key As String, mord As Integer) As String
On Error GoTo era
Dim myDat As Variant, i As Long, myWord As Variant, buf As Variant, flag(1) As Boolean
　　myDat = myRng
　　If Len(myTar2) = 0 Then Exit Function
　　集計 = "×"
　　myWord = Split(myTar2, Key)
　　flag(0) = True
　　For Each buf In myWord
　　　　flag(1) = False
　　　　For i = 1 To UBound(myDat, 1)
　　　　　　If myDat(i, 1) = myTar1 Then
　　　　　　　　If mord = 1 Then
　　　　　　　　　　If myDat(i, 2) = buf Then
　　　　　　　　　　　　flag(1) = True
　　　　　　　　　　　　Exit For
　　　　　　　　　　End If
　　　　　　　　Else
　　　　　　　　　　If LCase(myDat(i, 2)) = LCase(buf) Then
　　　　　　　　　　　　flag(1) = True
　　　　　　　　　　　　Exit For
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　End If
　　　　　　If Len(myDat(i, 1)) = 0 Then Exit For '★
　　　　Next i
　　　　If flag(1) = False Then
　　　　　　flag(0) = False
　　　　　　Exit For
　　　　End If
　　Next
　　If flag(0) Then
　　　　集計 = "○"
　　End If
　　Exit Function
era:
　　集計 = "Error"
End Function

補足

ありがとうございます。
動きました。

使い方、操作で教えて頂きたいのですが、
VBEの画面で、マクロのコードを開いた状態で、
デバックをしならば1行毎（ブレイクポイント毎）に
実行しながら内容を確認したいのですが、どうれば
よいのですか。

実行すると、マクロの登録画面見たいなのがでます。

回答No.5

eden3616

>使い方、操作で教えて頂きたいのですが、
>VBEの画面で、マクロのコードを開いた状態で、
>デバックをしならば1行毎（ブレイクポイント毎）に
>実行しながら内容を確認したいのですが、どうれば
>よいのですか。
>実行すると、マクロの登録画面見たいなのがでます。

ご質問がデバッグの行い方に推移しますが・・・・

1行目の下記のコードにカーソルをあわせてキーボードのF9キーを押してください。
Function 集計(myRng～省略～) As String
インジケータバーに「●」が入り、その行が茶色く（初期配色）なります。
（このインジケータバーをクリックしてもブレークポイントを設けることが出来ます）
この状態は、その行がブレークポイントとなっていることを表します。

ブレークポイントを設けた状態でマクロを実行してください。
今回の場合はChangeイベントにてマクロを実行しますので、
数式を入力するセルにカーソルをあわせ、F2→エンターキーを押してください。

マクロが実行され、ブレークポイントで処理が一時停止します。
この状態でF8（ステップ実行）を行えば1行ずつ動作を確認する事が出来ます。
ブレークポイントをその他の行に設けたのちに、F5（実行）すれば現在の処理位置から
次のブレークポイントで一時停止します。

他の方法としては関数（Function）ではなくSubプロシージャとして処理を作り変えて
基本的な内部のみを同一のコードにして通常通りデバッグする方法や
Subプロシージャから集計（Function）を呼び出す方法もあります。
（呼び出し元のプロシージャからステップ実行すれば呼び出し先でもステップ実行される）

お礼

ありがとうございます。

丁寧にデバックの使い方まで教えていただき
助かります。

回答No.3

eden3616

>>また現状は0005の「xyz」について、大文字小文字の違いでも不一致となります。
>とのことですが、大文字小文字の違いで不一致にはなりませんでした。
>excelのバージョンは、2010です。

失礼しました。
こちらのテストケースデータにて半角スペースが含まれていたため一致しない結果となっておりました。

現状は指定文字での区切りを分解して分解後にエクセル関数のCOUNTIF関数を使用して判別しています。
大小文字の差異を不一致とするためには処理を変える必要があります。

回答No.2

eden3616

>追加なのですが、シートBの内容に訂正と検索の方法が変わりまして、

バージョン書かれていないので手軽な方法で実装します。
エクセル2007以上でのみ動作致します。
最下のVBAコードと差し換えてください。

またセルC2に入力する数式を以下のようにして、下方向へオートフィルしてください。
　　=集計(シートB!A:A,A2,シートB!B:B,B2,",")

関数の引数は以下のように変更となります
　=集計(売上番号範囲,対象売上番号,商品名範囲,対象商品名,区切り文字)
　・売上番号範囲：シートB!A:A
　・対象売上番号：A2
　・商品名範囲：シートB!B:B
　・対象商品名：B2
　・区切り文字：","　・・・""で括って指定

また現状は0005の「xyz」について、大文字小文字の違いでも不一致となります。

■VBAコード

Function 集計(myRng1 As Range, myTar1 As Range, myRng2 As Range, myTar2 As Range, word As String) As String
Dim mySrcs As Variant, mySrc As Variant
If Len(myTar2) = 0 Then
　　集計 = ""
　　Exit Function
End If
On Error GoTo era
mySrcs = Split(myTar2.Value, word)
For Each mySrc In mySrcs
　　If WorksheetFunction.CountIfs(myRng1, myTar1, myRng2, mySrc) = 0 Then GoTo era
Next
集計 = "○"
Exit Function
era:
集計 = "×"
End Function

補足

ありがとうございます。

>また現状は0005の「xyz」について、大文字小文字の違いでも不一致となります。
とのことですが、大文字小文字の違いで不一致にはなりませんでした。

excelのバージョンは、2010です。

回答No.1

eden3616

ユーザー定義関数で・・・・

■使用法
(1)Alt+F11でVBEを開く
(2)挿入→標準モジュールより挿入する
(3)挿入した標準モジュールに最下のVBAコードを貼付け
(4)Alt+F11または右上の×でVBEを閉じる
(5)シートAのC2に以下の数式を入力して下へオートフィル
　　=集計(シートB!B:B,B2,",")

「集計」というユーザー定義関数をVBAで作成しています。
通常の関数と同様にイコール「=」でプロシージャ名「集計」を指定し、
括弧内に引数(検索範囲,対象セル,区切り文字)を指定すると結果が
関数を入力したセルへ表示されます。

引数の内容は以下のように入力してください
・検索範囲　→　B:B　・・・別のシートの場合は『シート名!セル範囲アドレス』
・対象セル　→　B2　・・・別のシートの場合は『シート名!セルアドレス』
・区切り文字　→　","　・・・""で括って指定してください

補足：
(1)対象セルが空白（ブランク）の場合は空白を表示するようにしています。
(2)ユーザー定義関数はVBAコードが記述されたブック以外では動作致しません。

■VBAコード
Function 集計(myRng As Range, myTar As Range, word As String) As String
Dim mySrcs As Variant, mySrc As Variant
If Len(myTar) = 0 Then
　　集計 = ""
　　Exit Function
End If
On Error GoTo era
mySrcs = Split(myTar.Value, word)
For Each mySrc In mySrcs
　　mySrc = WorksheetFunction.Match(mySrc, myRng, 0)
Next
集計 = "○"
Exit Function
era:
集計 = "×"
End Function

補足

ありがとうございます。

追加なのですが、シートBの内容に訂正と検索の方法が変わりまして、

シートB
セルA セルB
商品番号　商品名
0001 A
0001 B
0001 C
0001 D
0001 E
0002 A
0002 B
0003 AAA
0005 XYZ
　：

シートAのセルAの売り上げ番号がシートBのセルAの商品番号に存在した
場合、シートAのセルBにある商品名が、シートBのセルBの商品名に
存在するかを検索し、すべて存在したらシートAの該当する行のセルC
に、”〇”か”×”を設定したい。
また、シートAのセルAの売り上げ番号がシートBのセルAの商品番号に
存在したしない場合、シートAの該当する行のセルCに、”×”を設定
したい。

先程、教えて頂いた方法で行いたいのですが、お願いします。