Sub 条件付き書式記録()

'編集 > ジャンプ > セル選択 > 条件付き書式 > ＯＫ
    ActiveCell.SpecialCells(xlCellTypeAllFormatConditions).Select
'書式 > 条件付き書式 > 削除 > ３つチェックを入れて > ＯＫ > ＯＫ
    Selection.FormatConditions.Delete
'ピボットテーブル > 選択 > データ
    ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1").PivotSelect "", xlDataOnly
'書式 > 条件付き書式 > セルの値が１００以上なら黄緑色のパターンにする
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
        , Formula1:="100"
    Selection.FormatConditions(1).Interior.ColorIndex = 4
'A4セルを選択する
    Range("A4").Select

End Sub

Sub 条件付き書式記録_修正()

'画面の更新を止める
    Application.ScreenUpdating = False
'実行時エラーが発生しても処理を継続する
    On Error Resume Next
'条件付き書式の範囲の条件付き書式を削除する
    ActiveCell.SpecialCells(xlCellTypeAllFormatConditions).FormatConditions.Delete
'データエリアを選択する
    ActiveSheet.PivotTables(1).PivotSelect "", xlDataOnly
'条件付き書式を設定する
    Selection.FormatConditions.Add Type:=xlCellValue, _
        Operator:=xlGreaterEqual, Formula1:="100"
    Selection.FormatConditions(1).Interior.ColorIndex = 4
'A4セルを選択する
    Range("A4").Select
'エラー処理を無効にする
    On Error GoTo 0
'画面の更新を有効にする
    Application.ScreenUpdating = True

End Sub

Private Sub Worksheet_Calculate()
    Call 条件付き書式記録_修正
End Sub

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    Call 条件付き書式記録_修正
End Sub

Sub 条件付書式設定サンプル()
'データエリアのセルの数値が100以上ならパターンを黄緑色にする

    Dim PvtTbl As PivotTable    '対象ピボットテーブル
    Dim PvtFld1 As PivotField   '行フィールド
    Dim PvtFld2 As PivotField   '列フィールド
    Dim mySelect As Range       '処理前選択範囲
    Dim myTarget1 As Range      '行フィールドによる選択範囲
    Dim myTarget2 As Range      '列フィールドによる選択範囲

    With ActiveSheet

'実行時エラーが発生しても処理を継続する
        On Error Resume Next

'条件付き書式が設定されたセルの条件付き書式を削除する
        ActiveCell.SpecialCells(xlCellTypeAllFormatConditions).FormatConditions.Delete

'エラー処理を無効にする
        On Error GoTo 0

'ピボットテーブルをオブジェクト変数へ代入
        Set PvtTbl = .PivotTables(1)
    End With

'ピボットテーブルで
    With PvtTbl

'行エリアと列エリアのフィールド名を取得する
'(データフィールドは取得しない)
        On Error Resume Next
        If .RowFields(.RowFields.Count).Caption = "データ" Then
            Set PvtFld1 = .RowFields(.RowFields.Count - 1)
        Else
            Set PvtFld1 = .RowFields(.RowFields.Count)
        End If
        If .ColumnFields(.ColumnFields.Count) = "データ" Then
            Set PvtFld2 = .ColumnFields(.ColumnFields.Count - 1)
        Else
            Set PvtFld2 = .ColumnFields(.ColumnFields.Count)
        End If

'実行時エラーが発生せず、
        If Err.Number = 0 Then

'データエリアに集計数値があれば（実際はフィールド数と列数や行数の比較）
            If .RowRange.Rows.Count > .RowFields.Count And _
                .ColumnRange.Columns.Count > .ColumnFields.Count Then

'選択されている範囲を変数に取得する
                Set mySelect = Selection

                Application.ScreenUpdating = False

'対象エリアを選択して変数に取得する
                .PivotSelect PvtFld1.Caption, xlDataOnly
                Set myTarget1 = Selection
                .PivotSelect PvtFld2.Caption, xlDataOnly
                Set myTarget2 = Selection

'対象エリアの共有している範囲を選択する
                Application.Intersect(myTarget1, myTarget2).Select
                Set myTarget2 = Nothing
                Set myTarget1 = Nothing

'選択した範囲に対して条件付き書式を設定する
                With Selection
                    .FormatConditions.Add Type:=xlCellValue, _
                        Operator:=xlGreaterEqual, Formula1:="100"
                    .FormatConditions(1).Interior.ColorIndex = 4
                End With

'元の選択範囲を選択する
                mySelect.Select
                Set mySelect = Nothing
                Application.ScreenUpdating = True
            End If
        End If
        On Error GoTo 0
    End With

End Sub