- 締切済み
Excelで範囲検索
今EXCELにこのような表があります。 名前 点数 日付け A 20 200702 B 10 200701 C 30 200612 ： ： ： セルA1に200001 セルA2に200712 と値を入れると日付けがその間(200001～200712)にある行だけを表示するようにしたいです。 VLOOKUP関数だと日付けが一つしか取れないですし、列も１つしか表示させることができません。
- みんなの回答 （14）
- 専門家の回答
みんなの回答
- ham_kamo
- ベストアンサー率55% (659/1197)
- ham_kamo
- ベストアンサー率55% (659/1197)
- ham_kamo
- ベストアンサー率55% (659/1197)
一応、マクロを修正してみました。試してみてください。 ＜シートのマクロ＞ Private Sub CommandButton1_Click() Dim i As Integer Const DataStartCol As String = "P" 'データが始まる列 Const ScoreNum As Integer = 6 '抽出する点数の数 ScoreCol(1) = "Bo" '左側の点数の列 DateCol(1) = "BK" '左側の年月の列 ScoreCol(2) = "BU" '右側の点数の列 DateCol(2) = "BM" '右側の年月の列 SDate(1) = Range("B1").Value '始期（左）の値 EDate(1) = Range("B2").Value '終期（左）の値 SDate(2) = Range("D1").Value '始期（右）の値 EDate(2) = Range("D2").Value '終期（右）の値 PickOutCol(1) = "B" '抽出する左側の列 PickOutCol(2) = "I" '抽出する右側の列 Application.ScreenUpdating = False '抽出先をクリア Range(Cells(4, PickOutCol(1)), _ Cells(Rows.Count, PickOutCol(2)).Offset(, ScoreNum)).ClearContents '抽出 For WorkRow = 4 To Cells(Rows.Count, DataStartCol).End(xlUp).Row For i = 1 To 2 If IsInclude(1, i) Then If IsInclude(2, i) Then DataCopy DateMaxN(), i, ScoreNum Else DataCopy 1, i, ScoreNum End If ElseIf IsInclude(2, i) Then DataCopy 2, i, ScoreNum End If Next Next Application.ScreenUpdating = True End Sub Private Sub CommandButton2_Click() Range("A4", Cells(Rows.Count, "O")).ClearContents End Sub ＜標準モジュールのマクロ＞ （このプロシージャ以外は変更不要です） Sub DataCopy(FromN As Integer, ToN As Integer, Optional CopyNum As Integer) If CopyNum = 0 Then CopyNum = 1 Cells(WorkRow, PickOutCol(ToN)).Resize(1, CopyNum).Value = _ Cells(WorkRow, ScoreCol(FromN)).Resize(1, CopyNum).Value Cells(WorkRow, PickOutCol(ToN)).Offset(0, CopyNum).Value = _ Cells(WorkRow, DateCol(FromN)) End Sub
補足
何度もすみません。 変更点をお願いしてよろしいでしょうか？ 始期(左)→C5終期(右)→C6 始期(左)→E5終期(右)→E6 抽出データの表示する先頭セルがB10です。 ham_kamoさんに教えていただいた以前のマクロをExcelのレイアウト変更したのでマクロも変更して正常に動いてたのですが、今回いただいたマクロもレイアウトにそうように変更したのですが、上手くいきませんでした。 すみませんがお願いします。
- ham_kamo
- ベストアンサー率55% (659/1197)
こんにちは、ham_kamoです。 > 以前ですとB点数、C日付、D点数、E日付と4列に抽出していましたが > 抽出データをBからOに表示するので4列から14列になります。 えと、自分のマクロではA～Dになっています。おかしいな。 それはいいとして、日付が始期～終期の間であるという条件は以前と同じで、条件が一致すると、 B,C,D,E,F,G → 科目別点数を表示 H → 日付を表示 I,J,K,L,M,N → 科目別点数を表示 O → 日付を表示 と抽出される、ということでよろしいですか？
補足
早速ありがとうございます。 ＞B,C,D,E,F,G → 科目別点数を表示 ＞H → 日付を表示 ＞I,J,K,L,M,N → 科目別点数を表示 ＞O → 日付を表示 B → 日付を表示 C,D,E,F,G,H → 科目別点数を表示 I → 日付を表示 J,K,L,M,N,O → 科目別点数を表示 上記のように変更していただけないでしょうか？
- ham_kamo
- ベストアンサー率55% (659/1197)
こんにちは、ham_kamoです。メールが来るように指定していたので気づきました。列名の指定のところでもタイプミスをしていたようで失礼しました。自分でやっているときは、FとかGとかの列でテストして、アップするときに列名を書き換えたので、そのときにミスったようです。気がついてくれてよかったです。 それで、右側の数字が左側の範囲に入っているときに抽出されない不具合を修正しました。 元のマクロの '抽出 For WorkRow = 4 To Cells(Rows.Count, DataStartCol).End(xlUp).Row If IsInclude(1, 1) Then If IsInclude(2, 1) Then DataCopy DateMaxN(), 1 Else DataCopy 1, 1 End If End If If IsInclude(2, 2) Then If IsInclude(1, 2) Then DataCopy DateMaxN(), 2 Else DataCopy 2, 2 End If End If Next となっている部分を、以下に置きかえていただけますか？ （ちょっと難しく考えすぎて、かえって複雑なことをやってしまっていました） '抽出 For WorkRow = 4 To Cells(Rows.Count, DataStartCol).End(xlUp).Row For i = 1 To 2 If IsInclude(1, i) Then If IsInclude(2, i) Then DataCopy DateMaxN(), i Else DataCopy 1, i End If ElseIf IsInclude(2, i) Then DataCopy 2, i End If Next Next また不具合が出るかもしれないので、当分この質問は締め切らない方がいいかもしれませんね。この回答も補足欄かお礼欄のどちらかを残しておいた方がいいでしょう。補足やお礼が投稿されたときにメールを来る設定にしているのでこちらも気がつくと思います。 （質問者が追加で補足したいときに、お礼欄と補足欄を使い切っているとどうしようもない、というシステムはいまいちだな～と思っていたりします）
お礼
助かりました！！ なんとお礼を言えばいいのでしょう。本当にありがとうございます。 ham_kamoさんのおっしゃる通り補足が1度だけというシステムはいまいちだと思います。 またなにかあるかわからないので、締め切らないで補足欄はしばらく残しておきたいと思います。 本当にありがとうございます。 ham_kamoさんからの回答を楽しみにしていたので寂しくなります。 また質問しているときはどうぞよろしくお願いします。 就職活動中(プロフィールを拝見させていただきました)とのことですが、ようやく精神障害(うつ病など)が社会的に認知され始めだされ、就労となるとまだまだ整備段階中であると思います。 求職者だけががんばるのではなくもっと福祉、行政、企業が連携を深め、努力する必要があるみたいですね。 誤解を招いたらすみません。
補足
すみません。またご教授願いたいです。 2つ変更点があります。 1.表の変更 2.抽出データの増加 以前ですとB点数、C日付、D点数、E日付と4列に抽出していましたが抽出データをBからOに表示するので4列から14列になります。 この時点で以前AZにあった点数列はBJになります。 今回はBOからBZまでデータが増えました。 以前ですと検索内の日付と点数を表示していましたが。今回は点数の変わりに、追加分のデータを表示したいです。 BJが点数BKが日付BLが点数BMが日付となっておりBJ列の点数を表示する変わりにBOからBTを表示、BLの変わりにBUからBZを表示したいです。 以前の点数が合計とすると今回は科目別の点数を表示するといったところでしょうか。 ご理解いただけるでしょうか？
- ham_kamo
- ベストアンサー率55% (659/1197)
こんにちは、ham_kamoです。補足拝見しました。 抽出条件において、まだ確認しておきたいことがあるので、補足をお願いできますか？ ――――追加の4列―――― 始期 200601 始期 200702 終期 200701 終期 200703 ――――――表―――――――― 点数 日付け 点数 日付け 名前…点数 日付け 名前 日付け 20 200701 A … 20 200602 20 200701 10 200601 20 200702 B … 10 200601 20 200702 30 200602 10 200703 C … 30 200602 10 200702 ： ： ： ： ： (1)上記の場合、それぞれの始期～終期の範囲が重なることはあるのでしょうか。あった場合、正規表の日付が両方の範囲に含まれる可能性があります。その場合はどう抽出したらよいでしょうか。 (2)補足によると、 －－－－－－－－－－－－－－－－－－－－－－－ 名前「A」の抽出はどうなっているかと言いますと範囲内で新しい日付けの方だけを表示しています。 この場合ですと20 200602 20 200701の両方が左の検索範囲に含まれていますが直近の20 200701の方を表示させたいです。 －－－－－－－－－－－－－－－－－－－－－－－ とのことですが、両方が右の検索範囲に含まれている場合、それも直近のデータを表示させたい、ということでしょうか。その場合はAB列でなくCD列に表示させるのでしょうか。 (3)右側のデータだけが抽出された場合、AB列は空きでCD列にデータを抽出すればよいでしょうか。 とりあえず、 (1)→抽出範囲が重なることはない (2)→両方が右の検索範囲に含まれている場合は、直近のデータをC,D列に表示 (3)→右の検索条件だけに該当する場合は、C,D列に抽出 というようにマクロを組んでみました。ちょっとややこしくなったので、ユーザ定義関数を使ってます。 Alt+F11でVBAの画面を開き、「挿入」＞「標準モジュール」を選択して、右の画面に以下のマクロをコピーして貼り付けてください。 Public ScoreCol(2) As String, DateCol(2) As String Public SDate(2) As Long, EDate(2) As Long Public PickOutCol(2) As String Public WorkRow As Integer Function IsInclude(N1 As Integer, N2 As Integer) As Boolean 'N1 表の中の日付番号（左＝１、右＝２） 'N2 抽出条件の番号（左＝１、右＝２） If Cells(WorkRow, DateCol(N1)).Value >= SDate(N2) And _ Cells(WorkRow, DateCol(N1)).Value <= EDate(N2) Then IsInclude = True Else IsInclude = False End If End Function Function DateMaxN() As Integer If Cells(WorkRow, DateCol(1)).Value > Cells(WorkRow, DateCol(2)).Value Then DateMaxN = 1 Else DateMaxN = 2 End If End Function Sub DataCopy(FromN As Integer, ToN As Integer) Cells(WorkRow, PickOutCol(ToN)).Value = Cells(WorkRow, ScoreCol(FromN)) Cells(WorkRow, PickOutCol(ToN)).Offset(0, 1).Value = Cells(WorkRow, DateCol(FromN)) End Sub そして、ボタンの動作を記録しているマクロ（VBAの画面で左のシート名をダブルクリックで出てきます）の既存のマクロを、以下の内容と差し替えてください。 Private Sub CommandButton1_Click() Dim i As Integer Const DataStartCol As String = "E" 'データが始まる列 ScoreCol(1) = "AY" '左側の点数の列 DateCol(1) = "AZ" '左側の年月の列 ScoreCol(2) = "BA '右側の点数の列 DateCol(2) = "BB" '右側の年月の列 SDate(1) = Range("B1").Value '始期（左）の値 EDate(1) = Range("B2").Value '終期（左）の値 SDate(2) = Range("D1").Value '始期（右）の値 EDate(2) = Range("D2").Value '終期（右）の値 PickOutCol(1) = "A" '抽出する左側の列 PickOutCol(2) = "C" '抽出する左側の先頭セル Application.ScreenUpdating = False '抽出先をクリア Range("A4", Cells(Rows.Count, "D")).ClearContents '抽出 For WorkRow = 4 To Cells(Rows.Count, DataStartCol).End(xlUp).Row If IsInclude(1, 1) Then If IsInclude(2, 1) Then DataCopy DateMaxN(), 1 Else DataCopy 1, 1 End If End If If IsInclude(2, 2) Then If IsInclude(1, 2) Then DataCopy DateMaxN(), 2 Else DataCopy 2, 2 End If End If Next Application.ScreenUpdating = True End Sub まだ希望の動作と異なる場合は、補足をお願いします。
お礼
原因わかりました！！ ScoreCol(2) = "BA '右側の点数の列 を ScoreCol(2) = "BA" '右側の点数の列 にすれば正常に動作してくれました。 本当に長い間ありがとうございました。 いただいたマクロを自分なりに分析して勉強したいと思います。 本当にありがとうございます。
補足
ありがとうございます。 実行時エラー13 「型が一致しません」と出ます。 デバッグをクリックしてみると Sub DataCopy(FromN As Integer, ToN As Integer) 『Cells(WorkRow, PickOutCol(ToN)).Value = Cells(WorkRow, ScoreCol(FromN))』 Cells(WorkRow, PickOutCol(ToN)).Offset(0, 1).Value = Cells(WorkRow, DateCol(FromN)) End Sub 2重鍵括弧の部分が黄色で表示されています。 原因分かりますでしょうか？ お願いします。
- ham_kamo
- ベストアンサー率55% (659/1197)
ham_kamoです。 ようやくわかりました。抽出先と表の左右それぞれの列が対応するのですね。 とりあえず CommandButton1_Click() を以下の内容に差し替えてください。 Private Sub CommandButton1_Click() Dim ScoreCol(2) As String, DateCol(2) As String Dim SDate(2) As Long, EDate(2) As Long Dim PickOutCell(2) As Range Dim i As Integer, WorkRow As Integer ScoreCol(1) = "AY" '左側の点数の列 DateCol(1) = "AZ" '左側の年月の列 ScoreCol(2) = "BA" '右側の点数の列 DateCol(2) = "BB" '右側の年月の列 SDate(1) = Range("B1").Value '始期（左）の値 EDate(1) = Range("B2").Value '終期（左）の値 SDate(2) = Range("D1").Value '始期（右）の値 EDate(2) = Range("D2").Value '終期（右）の値 Set PickOutCell(1) = Range("A4") '抽出する左側の先頭セル Set PickOutCell(2) = Range("C4") '抽出する左側の先頭セル Application.ScreenUpdating = False '抽出先をクリア Range("A4", Cells(Rows.Count, "D")).ClearContents '抽出 For i = 1 To 2 For WorkRow = 4 To Cells(Rows.Count, DateCol(i)).End(xlUp).Row If Cells(WorkRow, DateCol(i)) >= SDate(i) And _ Cells(WorkRow, DateCol(i)) <= EDate(i) Then PickOutCell(i).Value = Cells(WorkRow, ScoreCol(i)).Value PickOutCell(i).Offset(0, 1).Value = Cells(WorkRow, DateCol(i)).Value Set PickOutCell(i) = PickOutCell(i).Offset(1, 0) End If Next Next '並べ替え Range("A3", Cells(Rows.Count, "B").End(xlUp)).Sort _ Key1:=Range("B4"), Key2:=Range("A4"), Header:=xlYes Range("C3", Cells(Rows.Count, "D").End(xlUp)).Sort _ Key1:=Range("D4"), Key2:=Range("C4"), Header:=xlYes Application.ScreenUpdating = True End Sub それから、抽出したデータの欄をクリアするボタンを作りたい場合は、No.4で書いた手順でボタンを作るか、抽出でボタンをコピーしてボタンをもう一つ作り、Captionプロパティに「クリア」と書いてダブルクリックし、以下のマクロを貼り付けてください。 Private Sub CommandButton2_Click() Range("A4", Cells(Rows.Count, "D")).ClearContents End Sub うまく動かない、あるいは私の方で認識がずれているところがあれば補足をお願いします。
お礼
気づいていただけたら幸いです。 もう1度補足させていただきたいです。 ――――追加の4列―――― 始期 200601 始期 200702 終期 200701 終期 200703 ――――――表―――――――― 点数 日付け 点数 日付け 名前…点数 日付け 名前 日付け 20 200701 A … 20 200602 20 200701 10 200601 20 200702 B … 10 200601 20 200702 30 (200602) 10 C… 30 200502 10 200602 ： ： ： ： ： 括弧の日付けが表示されません。 表示できるようお願いできないでしょうか？？
補足
ありがとうございます。動作しました。 用途を現場に聞いてなくて抽出することだけに気を取られていました。 申し訳ございませんが、もう1度補足させていただいてよろしいでしょうか。 ――――追加の4列―――― 始期 200601 始期 200702 終期 200701 終期 200703 ――――――表―――――――― 点数 日付け 点数 日付け 名前…点数 日付け 名前 日付け 20 200701 A … 20 200602 20 200701 10 200601 20 200702 B … 10 200601 20 200702 30 200602 10 200703 C … 30 200602 10 200702 ： ： ： ： ： このようにデータと同じ行に抽出させたいです。 名前「A」の抽出はどうなっているかと言いますと範囲内で新しい日付けの方だけを表示しています。 この場合ですと20 200602 20 200701の両方が左の検索範囲に含まれていますが直近の20 200701の方を表示させたいです。 該当する日付けがなければ空白をいれたいです。 何度も追加追加で申し訳ないですが、お願いできますでしょうか。
- imogasi
- ベストアンサー率27% (4737/17070)
- ham_kamo
- ベストアンサー率55% (659/1197)
すみませんが、もう少し補足していただけますか？表全体がどうなっているかこちらにはわかりませんので。 まず、 > A1に「始期」A2に「終期」で日付けをB1、B2とD1、D2に入力したいです。 ですが、検索範囲となる日付が２組出てきました。これは前回まで出てこなかったのですが、この２組の日付はどう扱うのでしょうか？ １．表のそれぞれの日付がどちらかの検索範囲内であればその日付と点数を抽出（検索条件：OR、抽出データ：OR） ２．表のそれぞれの日付が両方の検索範囲内であればその日付と点数を抽出（検索条件：AND、抽出データ：OR) ３．表の左右両方の日付がどちらかの検索範囲内であれば、両方の日付と点数を抽出（検索条件：OR、抽出データ：AND） ４．表の左右両方の日付が両方の検索範囲内であれば、両方の日付と点数を抽出（検索条件：AND、抽出データ：AND） といくつもパターンがあるのですが、どのように抽出すればよろしいでしょうか。 > 正規表に関連付けたいです。 すみませんが、これもよくわかりません。「正規表に関連づける」とは具体的にどういうことなのでしょうか。 > 欲を言うと二つほしいです。A,B列とC,D列の二つです。 これもまた新しい情報ですね。２組の列にはどう抽出しわけるのでしょうか。 １．単純に上から左→右、次の行に移って左→右、と２列ずつ使ってデータを並べていく ２．表の左側の点数、日付から抽出したデータはAB列、右側の点数、日付から抽出したデータはCD列 ３．それ以外（の場合は具体的に） これらの情報がないと、どういう条件でどういう形で抽出したらいいかわかりません。少しややこしくなりそうなので、オートフィルタは使わずに、マクロ内で日付を全部なめていって抽出範囲内のデータを抽出するようにしようと思いますが、よくあるパターンなので、上記の抽出条件、抽出方法に関する情報をできるだけ具体的に補足していただければ、すぐにでも作れるかと思います。
お礼
気づいていただけたらNo８のお礼欄を見てください。 お願いいたします。
補足
何度もすみません。 >検索範囲となる日付が２組出てきました。これは前回まで出てこなかったのですが、この２組の日付はどう扱うのでしょうか？ >２組の列にはどう抽出しわけるのでしょうか それぞれの検索範囲を抽出したいです。 B1,B2の抽出範囲のデータをA4に点数、B4に日付。 D1,D2の抽出範囲のデータをC4に点数、D4に日付。それぞれ検索範囲は表の左右両方の日付です。 ham_kamoさんの言葉をかりるのであれば、表のそれぞれの日付がそれぞれの検索範囲内であればその日付と点数を抽出ということになると思います。 >「正規表に関連づける」とは具体的にどういうことなのでしょうか。 すみませんこれは無視してください。 すみません。ご理解いただけたでしょうか？語彙力がなくて申し訳ないです。
- ham_kamo
- ベストアンサー率55% (659/1197)
No.4です。補足拝見しました。 まず、私が書いたマクロは、マクロ内でオートフィルタをかけているだけです。したがって、他のセル範囲に抽出には、オートフィルタで抽出したデータを抽出先のセル範囲にコピーし、さらにもう１つの日付でオートフィルタをかけて抽出→コピー、ということをしなければなりません。 つまり、大幅にマクロを書き直す必要があります。多少お時間をいただければ作ってみますが、いろいろと補足していただきたいことがあります。 ・補足欄の例を見ると、抽出した結果を「日付」を第１キー、「点数」を第２キーとして並び替えているように見えるが、そのように並び替えるのか ・表の左側に４列挿入、とあるが実際に抽出したデータを表示するのはどの列なのか。Ａ、Ｂ列なのか、Ｂ、Ｃ列なのか。 ・補足欄では、範囲指定する日付を 始期200612 終期200701 とあるが、「始期」「終期」という文字がA1,A2の日付の前につくのか。それとも「始期」「終期」はA1,A2に入っていて、200612,200701はB1,B2に入っているのか。 ・表のレイアウトは、 名前 点数 日付け 点数 日付け A 20 200602 20 200701 B 10 200601 20 200702 C 30 200612 10 200701 で間違いないのか。（他の項目の列が実は間にあるけど省略している、ということはないか） ・上記の表の左上のセル番地は？仮にE4とすると、データは５行目から始まり、日付の列はG列とI列ということになるが、それでよいのか。 以上、補足をお願いします。 あと、別のセル範囲に抽出するのであれば「全表示」ボタンは不要ですね。
補足
度々すみません。 >・補足欄の例を見ると、抽出した結果を「日付」を第１キー、「点数」を第２キーとして並び替えているように見えるが、そのように並び替えるのか 正規表に関連付けたいです。 >・表の左側に４列挿入、とあるが実際に抽出したデータを表示するのはどの列なのか。Ａ、Ｂ列なのか、Ｂ、Ｃ列なのか。 欲を言うと二つほしいです。A,B列とC,D列の二つです。 >・補足欄では、範囲指定する日付を… A1に「始期」A2に「終期」で日付けをB1、B2とD1、D2に入力したいです。 ・表のレイアウトは、… 実はご察しの通り省略しています。点数がAY、日付けがAZ、点数がBA、日付けがBBです。3行目が列タイトルで4行目からデータが入ってます。 ですので左上のセル表番地はE3です。 つたない説明でご理解いただけたでしょうか、どうぞよろしくお願いいたします。
- 1
- 2
補足
>始期(左)→C5 終期(左)→C6 >始期(右)→E5 終期(右)→E6 >ですよね。 そうです間違えていました。 ありがとうございます。 今回は表示する列が多いので検証に時間がかかりそうです。 どうもありがとうございます。