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

MyMemoWiki

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

提供: MyMemoWiki
2020年2月15日 (土) 07:32時点におけるPiroto (トーク | 投稿記録)による版 (ページの作成:「==Excel VBA オートフィルタをシート間で同期== [Excel][Excel VBA] ====オートフィルタの状態をシート間で同期させる==== Sub SyncAutoFil…」)
(差分) ← 古い版 | 最新版 (差分) | 新しい版 → (差分)
ナビゲーションに移動 検索に移動

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

[Excel][Excel 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