【EXCEL VBA（マクロ）】アドバンスフィルタ（AdvancedFilter）の設定方法をご紹介

アドバンスフィルタ

＊A1から最終のセルの範囲を指定してアドバンスフィルタを実施

Sub アドバンスフィルタ_A1から最終のセル範囲()                       '

Dim wb1 As Workbook
    Set wb1 = ThisWorkbook
Dim ws1 As Worksheet
    Set ws1 = ActiveSheet
Dim LastRow1 As Long
    LastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Dim LastCol1 As Long
    LastCol1 = ws1.Cells(1, Columns.Count).End(xlToLeft).Column

Dim LastCell As Range
    Set LastCell = ws1.Cells(LastRow1, LastCol1)
Dim TargetCell As Range
    Set TargetCell = ws1.Range("A1", LastCell)

TargetCell.AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=ws1.Range("A1:D2"), _
Unique:=False

MsgBox "完了"
End Sub

MEMO:

ws1.Range(“C32”).CurrentRegion.AdvancedFilter

別の例

Sub AdvancedFilterExample()
    Dim ws As Worksheet
    Dim filterRange As Range
    Dim criteriaRange As Range
    Dim targetRange As Range
    
    Set ws = ActiveSheet
    
    '// フィルタ条件の範囲を指定する
    Set filterRange = ws.Range("A1:B2")
    
    '// フィルタを適用する範囲を指定する
    Set targetRange = ws.Range("A3:B100")
    
    '// フィルタ条件を取得する
    Set criteriaRange = ws.Range(filterRange.Rows(2), filterRange.Rows(filterRange.Rows.Count))
    
    '// AdvancedFilterを実行する
    targetRange.AdvancedFilter _
        Action:=xlFilterInPlace, _
        CriteriaRange:=criteriaRange, _
        Unique:=False
End Sub

ActiveSheetのフィルタ条件を”A1:B2″に、フィルタを適用する範囲を”A3:B100″に設定しています。Actionパラメータには、フィルタの種類を指定します。上記の例では、xlFilterInPlaceを指定しています。CriteriaRangeパラメータには、フィルタ条件を格納する範囲を指定します。Uniqueパラメータには、フィルタ後にユニークな値を残すかどうかを指定します。

アドバンスフィルタ_グループ分け

Sub 抽出()  

Application.ScreenUpdating = False
  
  With Range("A1").CurrentRegion
      .Sort Key1:=.Columns(2), Order1:=xlAscending, Header:=xlYes
      .Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(3), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
  End With
      
      ActiveSheet.Outline.ShowLevels RowLevels:=2
      Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
      Sheets.Add(After:=Sheets(1)).Name = "抽出"
      
      ActiveSheet.Paste
      Columns(1).Delete
      
      Range("A1").CurrentRegion.Borders.LineStyle = True
      Cells.Replace What:="集計", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, _
        SearchFormat:=False, ReplaceFormat:=False
      Sheets(1).Activate
  
  With Range("A1").CurrentRegion
      .RemoveSubtotal
      .Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlYes
  End With
      
      Sheets("抽出").Activate

Application.ScreenUpdating = True
MsgBox "完了"
End Sub