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

MyMemoWiki

「Excel VBA オートフィルタをシート間で同期」の版間の差分

提供: MyMemoWiki
ナビゲーションに移動 検索に移動
1行目: 1行目:
 
==Excel VBA オートフィルタをシート間で同期==
 
==Excel VBA オートフィルタをシート間で同期==
[[Excel][Excel VBA]]
+
[[Excel]][[Excel VBA]]
 
====オートフィルタの状態をシート間で同期させる====
 
====オートフィルタの状態をシート間で同期させる====
 
  Sub SyncAutoFilter()
 
  Sub SyncAutoFilter()

2020年2月15日 (土) 08:19時点における版

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