| ページ一覧 | ブログ | twitter |  書式 | 書式(表) |

MyMemoWiki

Excel VBA オートフィルタをシート間で同期

提供: MyMemoWiki
2020年2月15日 (土) 08:19時点におけるPiroto (トーク | 投稿記録)による版
ナビゲーションに移動 検索に移動

Excel VBA オートフィルタをシート間で同期

ExcelExcel VBA

オートフィルタの状態をシート間で同期させる

Sub SyncAutoFilter()
    Dim srcSht      As Excel.Worksheet  '同期元のシート
    Dim dstSht      As Excel.Worksheet  '同期元のセル
    Dim srcCell     As Excel.Range      '同期元のシート
    Dim dstCell     As Excel.Range      '同期先のセル
    
    '対象セルの位置
    Dim r As Integer
    Dim c As Integer
    
    r = 2
    c = 1
    
    '同期元情報を変数にセット
    Set srcSht = Application.Sheets("Sheet1")
    Set srcCell = srcSht.Cells(r, c)
    '同期先情報を変数にセット
    Set dstSht = Application.Sheets("Sheet2")
    Set dstCell = dstSht.Cells(r, c)
    
    '同期処理
    Dim idx As Integer  'AutoFilter index
    Dim fld As Integer  'フィルタの対象となるフィールド番号(リストの左側から数えた番号)
    
    idx = 1
    fld = 1
    
    If srcSht.AutoFilter.Filters(idx).On Then
        Select Case srcSht.AutoFilter.Filters(idx).Operator
        Case 0
        '条件指定なし
            dstCell.AutoFilter Field:=fld, _
                                 Criteria1:=srcSht.AutoFilter.Filters(idx).Criteria1
        
        Case xlAnd, xlOr
        '条件指定 AND、OR
            dstCell.AutoFilter Field:=fld, _
                                 Criteria1:=srcSht.AutoFilter.Filters(idx).Criteria1, _
                                 Operator:=srcSht.AutoFilter.Filters(idx).Operator, _
                                 Criteria2:=srcSht.AutoFilter.Filters(idx).Criteria2
                                 
        Case xlTop10Items, xlBottom10Items, xlTop10Percent, xlBottom10Percent
        '条件指定 上位、下位の件数、%
            dstCell.AutoFilter Field:=fld, _
                                 Operator:=srcSht.AutoFilter.Filters(idx).Operator
        Case Else
            'NOP
        End Select
    Else
        ' フィルタの解除
        Call dstCell.AutoFilter(fld)
    End If
    
End Sub