[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『Function関数で複数条件の文字列を抽出したい』（みちる）
以前、下記のようなクロス集計表から収穫量のランクに応じた品種名を抜き出すFunction関数をこちらの掲示板で紹介して頂きました。
__|___A____|___B____|___C____|___D____|___E____|___F____|___G____|___H____|_____I_____|___J____|___K____
1| | | | | | | | | | | 2| | |A地区 |B地区 | | | | | | | 3|品種 |種類 |収穫量 |収穫量 | | | |A地区 |リンゴ |ブドウ |ナシ 4|紅玉 |リンゴ |A |C | | | |A |紅玉|つがる|巨峰 |幸水 5|王林 |リンゴ |B |A | | | |B |王林 | | 6|つがる |リンゴ |A |A | | | |C |ふじ|北斗 | |あきづき 7|ふじ |リンゴ |C |C | | | |D | |ピオーネ| 8|北斗 |リンゴ |C |A | | | | | | | 9|巨峰 |ブドウ |A |A | | | | | | | 10|ピオーネ|ブドウ |D |B | | | | | | | 11|幸水 |ナシ |A |C | | | | | | | 12|あきづき|ナシ |C |D | | | | | | |
I4 =条件2つで抽出($A$4:$A$12,"|",$B$4:$B$12,I$3,$C$4:$C$12,$H4)
Function 条件2つで抽出(抽出範囲 As Range, デリミタ As String, _
検索範囲1 As Range, 検索条件1 As String, _
検索範囲2 As Range, 検索条件2 As String) As String
Dim i As Long, ary() As Variant, c As Long
ReDim ary(1 To 抽出範囲.Cells.Count)
For i = 1 To 抽出範囲.Cells.Count
If 検索範囲1.Cells(i).Value = 検索条件1 And 検索範囲2.Cells(i).Value = 検索条件2 Then
c = c + 1
ary(c) = 抽出範囲.Cells(i).Value
End If
Next
If c = 0 Then Exit Function
ReDim Preserve ary(1 To c)
条件2つで抽出 = Join(ary, デリミタ)
End Function
これをアレンジして、二つの検索条件から品種名を抜き出すようアレンジしてみたのですが、エラーが出てしまいました。
アレンジした箇所は
Function 条件2つで抽出(抽出範囲 As Range, デリミタ As String, _
検索範囲1 As Range, 検索条件1 As String, _
検索範囲2 As Range, 検索条件2 As String,検索条件3 As String) As String
と
If 検索範囲1.Cells(i).Value = 検索条件1 And 検索範囲2.Cells(i).Value = 検索条件2 Or 検索条件3 Then
ですが、何が原因であるか教えて頂ければ幸いです。
＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
If 検索範囲1.Cells(i).Value = 検索条件1 And 検索範囲2.Cells(i).Value = 検索条件2 Then ↑は↓のようになっているのですから
条件１ 検索範囲1.Cells(i).Value = 検索条件1 And 条件２ 検索範囲2.Cells(i).Value = 検索条件2
のようになっているのですから、少なくとも↓のように、【検索条件3】が何と比較するのか書いてあげないとダメです。
条件１ 検索範囲1.Cells(i).Value = 検索条件1 And
条件２ 検索範囲2.Cells(i).Value = 検索条件2 or
条件３ 検索範囲2.Cells(i).Value = 検索条件3
~~~~~~~~~~~~~~~~~~~~~~~~
If 検索範囲1.Cells(i).Value = 検索条件1 And 検索範囲2.Cells(i).Value = 検索条件2 Or 検索範囲2.Cells(i).Value = 検索条件3 Then
■２
ちなみに【検索３】は何を置く（どのような条件にする）想定なのですか？
（たとえば、【ランク】がAorBなどを想定されているのでしょうか？）
（もこな２） 2021/06/22(火) 12:48
ご教授頂き誠にありがとうございます。ご存じの通り検索3にはまた新たに追加することになったランク（例えばCやD）を想定しております。
（みちる） 2021/06/22(火) 13:46
修正してテストしてみましたが、B,Dで試した場合Bは抽出できましたがDはK列の同じランクの品種まで抽出してしまいました。申し訳ありませんが、他に構文などのミスがあれば教えて頂ければ幸いです。
H列 I列 J列 K列
２ ＿＿｜＿＿＿ |＿りんご＿｜ぶどう＿｜
・
・
・
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
８ B｜備考欄| ｜
＿＿＿＿＿＿ ＿＿＿＿＿＿＿＿＿＿＿＿＿ ９ D｜ | ｜ 10 ｜ | ｜
J8＝条件2つで抽出アレンジ($A$4:$A$12,"|",$B$4:$B$12,J$2,$C$4:$C$12,$H8,$H9)
（みちる） 2021/06/22(火) 14:45
（この掲示板では↓のように記事番号を二重角括弧で括るとリンクになります） [[20210615165159]] 『条件を変えながらオートフィルタで抽出し、指定セルに転記する』（みちる）
■４
前トピックを拝見しました。元々マクロで処理することを考えていらっしゃったのですよね？
白茶さんが仰るように「抽出」と「条件を巡回」の部分をわけることはその通りだとおもいますが、ユーザー定義関数を作って【ワークシート上】で処理するのはどうなのかなぁとおもいます。
（おそらく、白茶さんも"考え方のひとつ"と仰っているのでお勧めされてるものではないと思いますが）
一応↓のようなものを作り
Function 俺式関数壱(表範囲 As Range, 種類 As String, ランク As String, 地区列 As Long) As String
Dim 地区 As Variant
Dim buf As String, tmpRNG As Range, 行 As Long
For 行 = 1 To 表範囲.Rows.Count
If 表範囲.Cells(行, 2).Value = 種類 Then
If UBound(Filter(Split(ランク, ","), 表範囲.Cells(行, 地区列).Value)) > -1 Then
buf = buf & 表範囲.Cells(行, 1).Value & "|"
End If
End If
Next 行
If buf <> "" Then buf = Left(buf, Len(buf) - 1)
俺式関数壱 = buf
End Function
I4セルに↓の数式を入力し、必要な範囲にコピーすれば
=俺式関数壱($A$4:$D$12,I$3,$H4,MATCH($H$3,$A$2:$D$2,0))
↓のようになりますが、
__|___A____|___B____|___C____|___D____|___E____|___F____|___G____|___H____|_____I_____|________J_______|___K____ 1| | | | | | | | | | | 2| | |A地区 |B地区 | | | | | | | 3|品種 |種類 |収穫量 |収穫量 | | | |A地区 |リンゴ |ブドウ |ナシ 4|紅玉 |リンゴ |A |C | | | |A |紅玉|つがる|巨峰 |幸水 5|王林 |リンゴ |B |A | | | |B |王林 | | 6|つがる |リンゴ |A |A | | | |C |ふじ|北斗 | |あきづき 7|ふじ |リンゴ |C |C | | | |D | |ピオーネ | 8|北斗 |リンゴ |C |A | | | |B,D |王林 |ピオーネ | 9|巨峰 |ブドウ |A |A | | | |A,D |紅玉|つがる|巨峰|ピオーネ |幸水 10|ピオーネ|ブドウ |D |B | | | | | | | 11|幸水 |ナシ |A |C | | | | | | | 12|あきづき|ナシ |C |D | | | | | | |
わざわざワークシート上で計算させずとも↓のようにすれば、値として書き込まれます
Sub さんぷる()
Dim MyRNG As Range
Dim 列 As Long
With ActiveSheet
On Error Resume Next
列 = Application.Match(.Range("H3").Value, .Range("A2:D2"), 0)
On Error GoTo 0
If 列 = 0 Then Exit Sub
For Each MyRNG In .Range("I4:K9")
MyRNG.Value = 俺式関数壱(.Range("A4:D12"), .Cells(3, MyRNG.Column).Value, .Cells(MyRNG.Row, "H").Value, 列)
Next MyRNG
End With
End Sub
■５
ワークシートに数式として、書いた場合、当然再計算の時には対象となるわけですが、今回の表ってそれが重要なのでしょうか？
さらには、マクロを実行した場合は【元に戻す】の情報がクリアされるため、マクロ実行以前に戻ることが出来なくなっちゃうわけですが、ユーザー定義関数もマクロですからこの制限に引っかかっちゃいます。
よって、いらんときに再計算されてもうざったいだけだとおもうので、私なら必要な時にだけマクロを実行し、ワークシート上では呼び出さない（数式にはしない）ですね。たぶん。
（もこな２） 2021/06/22(火) 17:12
大変貴重なご意見頂き、誠にありがとうござます。
私が数式で処理しようした理由は、Functionマクロをマクロで処理するという発想がもともとなかったことと別ブックのデータベース表から複数のブックへ参照することが前提であったため、データベース表を修正すれば自動的にそれらの値が変わる方が都合が良かったからと考えたからです。
稚拙な理由とは思われますが、どうかご容赦頂きたく思います。
（みちる） 2021/06/22(火) 18:17
追加のご質問ですが、昨日教えて頂いたマクロを試してみましたが、同一ワークシートでは上手くいきましたが、ブックを分けるとうまく抽出できませんでした。
テストでこのようなマクロを作成しましたがどこに原因にあるでしょうか。ご教授頂けると幸いです。
Sub さんぷる()
Dim MyRNG As Range
Dim 列 As Long
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\データベース.xlsm")
Set ws = wb.Worksheets("表")
With ActiveSheet
On Error Resume Next
列 = Application.Match(.Range("H3").Value, .ws.Range("A2:D2"), 0)
On Error GoTo 0
If 列 = 0 Then Exit Sub
For Each MyRNG In .Range("I4:K9")
MyRNG.Value = 俺式関数壱(.ws.Range("A4:D12"), .ws.Cells(3, MyRNG.Column).Value, .ws.Cells(MyRNG.Row, "H").Value, 列)
Next MyRNG
End With
wb.Close SaveChanges:=False
End Sub
（みちる） 2021/06/23(水) 13:19
とりあえず気づいたこと。 wsにはすでにwbブックの表シートが入っているので .ws.〜 だとアクティブシートのwbブックの表シートとなってしまう。 .ws.〜 の頭の.を取ってみてくれ。 （ねむねむ） 2021/06/23(水) 13:25
Sub さんぷる_修正()
Dim MyRNG As Range
Dim 列 As Long
'Dim wb As Workbook
Dim ws As Worksheet
With ActiveSheet '★位置を修正
'Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\データベース.xlsm")
Set ws = Workbooks.Open(Filename:=ThisWorkbook.Path & "\データベース.xlsm").Worksheets("表")
On Error Resume Next
列 = Application.Match(.Range("H3").Value, .ws.Range("A2:D2"), 0)
On Error GoTo 0
If 列 = 0 Then Exit Sub
For Each MyRNG In .Range("I4:K9")
'MyRNG.Value = 俺式関数壱(.ws.Range("A4:D12"), .ws.Cells(3, MyRNG.Column).Value, .ws.Cells(MyRNG.Row, "H").Value, 列)
MyRNG.Value = 俺式関数壱(ws.Range("A4:D12"), ws.Cells(3, MyRNG.Column).Value, .ws.Cells(MyRNG.Row, "H").Value, 列)
Next MyRNG
End With
ws.Parent.Close SaveChanges:=False
End Sub
'==============================================================
Function 俺式関数壱(表範囲 As Range, 種類 As String, ランク As String, 地区列 As Long) As String
Dim 地区 As Variant
Dim buf As String, tmpRNG As Range, 行 As Long
For 行 = 1 To 表範囲.Rows.Count
If 表範囲.Cells(行, 2).Value = 種類 Then
If UBound(Filter(Split(ランク, ","), 表範囲.Cells(行, 地区列).Value)) > -1 Then
buf = buf & 表範囲.Cells(行, 1).Value & "|"
End If
End If
Next 行
If buf <> "" Then buf = Left(buf, Len(buf) - 1)
俺式関数壱 = buf
End Function
（もこな２） 2021/06/23(水) 13:45
修正したマクロでテストしてみましたが、やはり抽出されないようです。列 = 〜とMyRNG.Value =〜に.ws.〜があったのでそれを修正しても駄目でした。
マクロは最後まで実行されており、エラーは起きていない状態なのですが、他に原因はありますでしょうか？
何度も申し訳ありませんが、ご教授頂けると幸いです。
（みちる） 2021/06/23(水) 15:09
ちなみに数式でもテストしてみましたが、テスト用の果物の表では抽出できましたが、本番用の表では抽出できませんでした。
本番用の表は2000行ぐらいのものでデータ個数が30万個ぐらいあります。ファイルが重いとうまく抽出できない原因になりますでしょうか？
（みちる） 2021/06/23(水) 16:15
■７
＞マクロは最後まで実行されており、エラーは起きていない状態
どうやって確認しましたか？
ステップ実行して変数に何が格納されているか（というかユーザー定義関数に何が与えられているか）チェックすれば気づけたとおもいますが↓が適切ではないですね。
MyRNG.Value = 俺式関数壱(ws.Range("A4:D12"), ws.Cells(3, MyRNG.Column).Value, ws.Cells(MyRNG.Row, "H").Value, 列)
ちょっと整理すると、プロシージャと関数は以下のような関係性になっていたわけですが理解できてますか？
ws.Range("A4:D12") ws.Cells(3, MyRNG.Column).Value ws.Cells(MyRNG.Row, "H").Value 列
↓ ↓ ↓ ↓
表範囲 As Range 種類 As String ランク As String, 地区列 As Long
でも、本来はこうですよね
表範囲・・・・・・・・「データベース.xlsm」の「表」シートの「A4:D12」セルを指定 種類 ・・・・・・・・「ActiveSheet」の「3行目、MyRNG.Column」にデータがある ランク・・・・・・・・「ActiveSheet」の「MyRNG.Row、H列」にデータがある 地区列・・・・・・・・・・「ActiveSheet」のH3セルと同じものが「データベース.xlsm」の「表」シートの「A2:D2」セルの何番目にあるか調べる
すなわち、【種類】【ランク】は「ActiveSheet」から値を取得すべきところ、【ws.】を付けてしまったがために「データベース.xlsm」の「表」シートから値を取得してしまい、""を抽出条件にしてしまっていたので見つからなかったということでしょう。
■８
したがって、↓のように修正すればよいですね。
Sub さんぷる_修正2()
Dim MyRNG As Range
Dim 列 As Long
Dim ws As Worksheet
With ActiveSheet
Set ws = Workbooks.Open(Filename:=ThisWorkbook.Path & "\データベース.xlsm").Worksheets("表")
On Error Resume Next
列 = Application.Match(.Range("H3").Value, ws.Range("A2:D2"), 0)
On Error GoTo 0
If 列 = 0 Then Exit Sub
For Each MyRNG In .Range("I4:K9")
MyRNG.Value = 俺式関数壱(ws.Range("A4:D12"), .Cells(3, MyRNG.Column).Value, .Cells(MyRNG.Row, "H").Value, 列)
Next MyRNG
End With
ws.parent.Close SaveChanges:=False
End Sub
'==============================================================
Function 俺式関数壱(表範囲 As Range, 種類 As String, ランク As String, 地区列 As Long) As String
Dim 地区 As Variant
Dim buf As String, tmpRNG As Range, 行 As Long
For 行 = 1 To 表範囲.Rows.Count
If 表範囲.Cells(行, 2).Value = 種類 Then
If UBound(Filter(Split(ランク, ","), 表範囲.Cells(行, 地区列).Value)) > -1 Then
buf = buf & 表範囲.Cells(行, 1).Value & "|"
End If
End If
Next 行
If buf <> "" Then buf = Left(buf, Len(buf) - 1)
俺式関数壱 = buf
End Function
（もこな２） 2021/06/23(水) 19:02
＞さらには、マクロを実行した場合は【元に戻す】の情報がクリアされるため、
＞マクロ実行以前に戻ることが出来なくなっちゃうわけですが、
＞ユーザー定義関数もマクロですからこの制限に引っかかっちゃいます。
本当ですか。
（マナ） 2021/06/23(水) 20:03
もこな２さん。大変分かりやすく解説して頂き、ありがとうございます。
エラーが起きていないというのは、最後のデータベースファイルを閉じる動作まで完了しているという意味で変数に何が格納されているということまでは確認しておりませんでした。以後確認するように気を付けます。
ご指摘の通り修正しましたら、無事抽出することが出来ました。長い時間お付き合いくださり誠に感謝いたします。分からない事だらけでしたので今回のことを踏まえ、もっとよく勉強してみたいと思います。
（みちる） 2021/06/24(木) 10:34
テスト用のファイルで試した際、感動のあまり本番用のファイルで試さずコメントしてしまいました。
本番用のファイルでファイルで試した結果、またうまく抽出できなかったので色々と原因を探った結果、空欄の品種まで抽出していたことが分かりました。
テスト用のものに書いていなかった私のミスで申し訳ありませんが空欄を除外する場合、どのようにアレンジすればよいでしょうか。
（みちる） 2021/06/24(木) 15:04
__|___A____|___B____|___C____|___D____|___E____|___F____|___G____|___H____|_____I_____|________J_______|___K____ 1| | | | | | | | | | | 2| | |A地区 |B地区 | | | | | | | 3|品種 |種類 |収穫量 |収穫量 | | | |A地区 |リンゴ |ブドウ |ナシ 4|紅玉 |リンゴ |D |C | | | |A |つがる |巨峰 |幸水 5|王林 |リンゴ | |A | | | |B |北斗 | | 6|つがる |リンゴ |A |A | | | |C |ふじ | |あきづき 7|ふじ |リンゴ |C |C | | | |D |紅玉 | | 8|北斗 |リンゴ |B |A | | | |B,D |北斗|紅玉 | | 9|巨峰 |ブドウ |A | | | | |A,D |紅玉|つがる|巨峰 |幸水 10|ピオーネ|ブドウ | |B | | | | | | | 11|幸水 |ナシ |A |C | | | | | | | 12|あきづき|ナシ |C | | | | | | | | （みちる） 2021/06/24(木) 15:40
さしあたって、表シートと出力先のシートは別々なのでしょうから、横着せずにちゃんと分けて提示して下さい。
また、どうなるべきがどうなったのか比較して理解できるように、それぞれを示して下さい。
（もこな２） 2021/06/24(木) 16:28
大変失礼致しました。
分かれたファイルは下記のようになっております。
__|___A____|___B____|___C____|___D____|__ 1| | | | | 2| | |A地区 |B地区 | 3|品種 |種類 |収穫量 |収穫量 | 4|紅玉 |リンゴ |D |C | 5|王林 |リンゴ | |A | 6|つがる |リンゴ |A |A | ・・・データベース.xlsx の 表シート 7|ふじ |リンゴ |C |C | 8|北斗 |リンゴ |B |A | 9|巨峰 |ブドウ |A | | 10|ピオーネ|ブドウ | |B | 11|幸水 |ナシ |A |C | 12|あきづき|ナシ |C | |
__|___A____|___B______ |___C_______|___D____|__ | | | | | | | | | | |A地区 |リンゴ |ブドウ |ナシ | |A |つがる |巨峰 |幸水 | |B |北斗 | | | ・・・抽出先.xlsm の Sheet1 |C |ふじ | |あきづき| |D |紅玉 | | | |B,D |北斗|紅玉 | | | |A,D |紅玉|つがる|巨峰 |幸水 | | | | | | | | | | |
『求めること』…抽出先ファイルのSheet１にデータベースファイルから空欄を除いたランクと種類に当てはまる品種のみを抽出したいと考えております。
『現在の状況』…データベースのランクが空欄になっているものと一緒に抽出されてしまっている。（例えば、A地区のリンゴはつがるのみだが、空欄の王林まで抽出してしまいます。）
(質問)下記のFunctionマクロのどこを修正すれば求める結果が得られますでしょうか。
Function 俺式関数壱(表範囲 As Range, 種類 As String, ランク As String, 地区列 As Long) As String
Dim 地区 As Variant
Dim buf As String, tmpRNG As Range, 行 As Long
For 行 = 1 To 表範囲.Rows.Count
If 表範囲.Cells(行, 2).Value = 種類 Then
If UBound(Filter(Split(ランク, ","), 表範囲.Cells(行, 地区列).Value)) > -1 Then
buf = buf & 表範囲.Cells(行, 1).Value & "|"
End If
End If
Next 行
If buf <> "" Then buf = Left(buf, Len(buf) - 1)
俺式関数壱 = buf
End Function
（みちる） 2021/06/24(木) 17:20
さしあたって、別案（前トピックでボツになったオートフィルタを使用）
Sub 別案()
Dim 出力先 As Range
Dim x As Long, y As Long
Dim MyRNG As Range
Dim buf As String
Dim 地区列 As Variant
Set 出力先 = ThisWorkbook.Worksheets("Sheet1").Range("B4:D9")
With ThisWorkbook.Worksheets("表")
地区列 = Application.Match(出力先.Cells(1).Offset(-1, -1).Value, .Rows(2), 0)
If IsError(地区列) Then Exit Sub
.AutoFilterMode = False
.Rows(3).AutoFilter
For x = 1 To 出力先.Rows.Count
For y = 1 To 出力先.Columns.Count
.AutoFilter.Range.AutoFilter Field:=2, Criteria1:=出力先.Rows(1).Offset(-1).Cells(1, y).Value
.AutoFilter.Range.AutoFilter Field:=地区列, Criteria1:=Split(出力先.Columns(1).Offset(, -1).Cells(x, 1).Value, ","), Operator:=xlFilterValues
If .Cells(.Rows.Count, "A").End(xlUp).Row <> 3 Then
buf = ""
For Each MyRNG In Intersect(.AutoFilter.Range.Columns(1), .AutoFilter.Range.Columns(1).Offset(1))
If Not MyRNG.EntireRow.Hidden Then buf = buf & MyRNG.Value & "|"
Next MyRNG
If buf <> "" Then 出力先.Cells(x, y).Value = Left(buf, Len(buf) - 1)
End If
Next y
Next x
End With
End Sub
（もこな２） 2021/06/24(木) 19:54
失礼。よく考えたら、対応する地区列が空欄で無い場合という条件を加えるだけでした。
Function 俺式関数壱(表範囲 As Range, 種類 As String, ランク As String, 地区列 As Long) As String
Dim 地区 As Variant
Dim buf As String, tmpRNG As Range, 行 As Long
For 行 = 1 To 表範囲.Rows.Count
If 表範囲.Cells(行, 2).Value = 種類 Then
If 表範囲.Cells(行, 地区列).Value <> "" Then
If UBound(Filter(Split(ランク, ","), 表範囲.Cells(行, 地区列).Value)) > -1 Then
buf = buf & 表範囲.Cells(行, 1).Value & "|"
End If
End If
End If
Next 行
If buf <> "" Then buf = Left(buf, Len(buf) - 1)
俺式関数壱 = buf
End Function
また、マナさんご指摘の「元に戻す」には影響ないのではとのご指摘も、その通りでした。
重ね重ね失礼しました。
（もこな２） 2021/06/25(金) 07:35
本番用のファイルで試してみましたら求めたい結果が無事抽出されました。自力ではとても無理なところを長い時間にわたって方法を考えて下さり、誠に感謝の念に堪えません。
今後もこの掲示板を参考にしつつ、勉強していこうと思います。
重ねてお礼申し上げます。
（みちる） 2021/06/25(金) 11:12
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.