質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

88.19%

VBA 日付の絞り込み

解決済

回答 2

投稿

  • 評価
  • クリップ 0
  • VIEW 315

tttkkk

score 13

VBAを使って、日付で表を絞り込みたいのですが、上手くいかないため、質問させて頂きました。

画像のような表で、「いつから」「いつまで」の指定した日付の範囲で、その日付があるIDの人をを絞り込みたいです。
例えば、この画像ですと、2021/01/03~2021/01/10までのIDの人は a と f が該当するので、その人をマクロを実行した時に表示させたいという感じです。

一つの列の日付では絞り込むことができるのですが、複数の列にまたがって絞り込む方法がわかりませんでした。
以下に私のコードを載せさせて頂きます。

Sub filterDate()

Dim fromDate As Date, toDate As Date
fromDate = Sheet5.Cells(7, 2).Value
toDate = Sheet5.Cells(8, 2).Value

Sheet5.Cells(11, 1).AutoFilter 2, ">=" & fromDate, xlAnd, "<=" & toDate

End Sub


上記のようなコードでは当然ですが、2列目でしか絞り込むとができず、 a も f も表示されない実行結果となってしまいます。

安直に考えて

Sheet5.Cells(11, 1).AutoFilter 2 Or 3 Or 4 Or 5 Or 6 Or 7, ">=" & fromDate, xlAnd, "<=" & toDate


のように、fieldの引数をOrで繋げてみてもはやりダメでした。

複数の列から日付の範囲に入っている全ての人を絞り込むVBAはどのように書けば宜しいでしょうか。
イメージ説明

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • radames1000

    2021/01/15 09:24

    最終的にはどんな表にしたいのですか?

    キャンセル

  • tttkkk

    2021/01/16 15:28

    最終的と言うと、私が的を射た回答をできているか分かりませんが、
    日付で絞り込みをかけれるようなマクロを組みたいというのが私の最終的な部分です。

    表はほとんどこれに近いものを作ろうと思っております。
    ですので、この表で範囲内の日付の人を絞り込むことができれば、最終的な表には簡単に応用が効くかと思っております。

    キャンセル

回答 2

checkベストアンサー

0

AutoFilter に配列を組み合わせて複数条件に合致するものを抽出するようにしてみました。

IdAddress 、StartColumn 、EndColumn は実際のファイルに合わせて変えてください。
ここでは、StartColumn は最初の日付列(「日付①」)の列番号、
EndColumn は最後の日付列(「日付⑥」)の列番号としています。

Sub filterDate()

    Set Sheet5 = ActiveWorkbook.Worksheets("Sheet5")

    Dim fromDate As Date, toDate As Date
    fromDate = Sheet5.Cells(7, 2).Value
    toDate = Sheet5.Cells(8, 2).Value

    '指定した日付範囲の条件に合致するIDを格納する配列
    ReDim FilterArray(0) As String

    '「id」の見出しがあるセル番号
    IdAddress = "A11"
    '日付の開始列
    StartColumn = 2
    '日付の終了列
    EndColumn = 7

    Range(Range(IdAddress).Offset(1, 0), Cells(Rows.Count, 1).End(xlUp)).Select

    For Each ID In Selection:
        For col = StartColumn To EndColumn:
            TargetDate = Cells(ID.Row, col).Value
            'そのIDが日付を含んでいる場合は、配列に格納する。
            If TargetDate >= fromDate And TargetDate <= toDate Then
                n = UBound(FilterArray) + 1
                ReDim Preserve FilterArray(n)
                FilterArray(n) = Cells(ID.Row, 1).Value
                Exit For
            End If
        Next
    Next

    ' 条件に合致するIDをフィルター
    Sheet5.Cells(11, 1).AutoFilter 1, FilterArray, xlFilterValues

End Sub

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2021/01/17 11:03

    ありがとうございます。
    このコードをそのままコピペしましたら私の意図している通りにフィルターをかけることが出来ました。
    ただ私のスキルがまだ足りなく、どのメソッドがどの動きを示すのか分からない部分が多々あるので、それをまず勉強していきたいと思います!

    キャンセル

0

H11セルに"範囲判定"等の列名を指定し、
H12セルに

=OR((AND(D12>=fromDate,D12>=<=toDate),(AND(E12>=fromDate,E12>=<=toDate),(AND(F12>=fromDate,F12>=<=toDate))


を設定し、H列がtrueの行を絞り込めば、思惑の絞り込みができるでしょう。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 88.19%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る