Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


9146 / 76732 ←次へ | 前へ→

【73152】Re:複数条件の検索抽出
回答  M_GUCHI E-MAIL  - 12/11/21(水) 11:57 -

引用なし
パスワード
   ▼UO3 さん:
早速の回答本当にありがとうございます。
今見ただけで実行はしていませんが、まずは感謝をお伝いしたいと思います。
後ほどじっくり実施してみたいと思います。重ねてお礼申し上げます。

>▼M_GUCHI さん:
>
>それではオートフィルター案とフィルターオプション案を。
>フィルターオプション案では検索シートの M1:P2 を作業域として使っています。
>もし、ここが別の項目で使われているなら、あいているところに変更してください。
>
>Sub Sample1()  'オートフィルター
>  Dim str1 As String
>  Dim str2 As String
>  Dim str3 As String
>  Dim str4 As String
>  Dim myR As Range
>  
>  Application.ScreenUpdating = False
>  
>  With Sheets("A")  '検索条件シート
>    str1 = .Range("H1").Value
>    str2 = .Range("I1").Value
>    str3 = .Range("J1").Value
>    str4 = .Range("K1").Value
>  End With
>  
>  With Sheets("B")  '名簿シート
>    .AutoFilterMode = False   '念のためリセット
>    .Range("A1").AutoFilter   'オートフィルター設定
>    Set myR = .AutoFilter.Range 'リストアドレス
>  End With
>  
>  myR.AutoFilter Field:=3, Criteria1:=str1
>  myR.AutoFilter Field:=4, Criteria1:=str2
>  myR.AutoFilter Field:=5, Criteria1:=str3
>  myR.AutoFilter Field:=6, Criteria1:=str4
>  
>  With Sheets("C")  '転記シート
>    .UsedRange.ClearContents
>    If WorksheetFunction.Subtotal(106, myR.Columns(1)) > 1 Then '抽出あり
>      myR.Copy .Range("A1")
>      .Cells.Sort Order1:=xlDescending, Key1:=.Columns("A"), Header:=xlYes
>      With .Range("A1").CurrentRegion
>        If .Rows.Count > 51 Then
>          .Resize(.Rows.Count - 51).Offset(51).Clear
>        End If
>      End With
>      .Select
>    End If
>  End With
>  
>  myR.Parent.AutoFilterMode = False  'オートフィルター解除
>  
>  Application.ScreenUpdating = True
>  MsgBox "抽出処理完了です"
>  
>End Sub
>
>Sub Sample2()  'フィルターオプション
>  Dim cr As Range
>  
>  Application.ScreenUpdating = False
>  
>  With Sheets("A")  '検索条件シート
>    Set cr = .Range("M1:P2")  '作業用検索条件領域
>    cr.Rows(1).Value = Sheets("B").Range("C1:F1").Value '抽出項目ラベル
>    '検索条件のセット
>    cr(2, 1).Value = "'=" & .Range("H1").Value
>    cr(2, 2).Value = "'=" & .Range("I1").Value
>    cr(2, 3).Value = "'=" & .Range("J1").Value
>    cr(2, 4).Value = "'=" & .Range("K1").Value
>  End With
>    
>  With Sheets("C")  '転記シート
>    .UsedRange.ClearContents
>    Sheets("B").Columns("A:J").AdvancedFilter Action:=xlFilterCopy, _
>      CriteriaRange:=cr, CopyToRange:=.Range("A1"), Unique:=False
>    .Cells.Sort Order1:=xlDescending, Key1:=.Columns("A"), Header:=xlYes
>    With .Range("A1").CurrentRegion
>      If .Rows.Count > 51 Then
>        .Resize(.Rows.Count - 51).Offset(51).Clear
>      End If
>    End With
>    cr.Clear
>    .Select
>  End With
>  
>  Application.ScreenUpdating = True
>  MsgBox "抽出処理完了です"
>  
>End Sub
0 hits

【73145】複数条件の検索抽出 M_GUCHI 12/11/20(火) 16:53 質問
【73146】Re:複数条件の検索抽出 UO3 12/11/20(火) 17:34 発言
【73147】Re:複数条件の検索抽出 m_guchi 12/11/20(火) 21:46 発言
【73148】Re:複数条件の検索抽出 UO3 12/11/21(水) 6:14 発言
【73149】Re:複数条件の検索抽出 UO3 12/11/21(水) 6:16 発言
【73150】Re:複数条件の検索抽出 M_GUCHI 12/11/21(水) 10:22 回答
【73151】Re:複数条件の検索抽出 UO3 12/11/21(水) 11:19 発言
【73152】Re:複数条件の検索抽出 M_GUCHI 12/11/21(水) 11:57 回答
【73155】Re:複数条件の検索抽出 m_guchi 12/11/21(水) 19:40 お礼

9146 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free