Excel VBA質問箱 IV

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

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


9143 / 76732 ←次へ | 前へ→

【73155】Re:複数条件の検索抽出
お礼  m_guchi  - 12/11/21(水) 19:40 -

引用なし
パスワード
   ▼M_GUCHI さん:
>▼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

1 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 お礼

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