1

Sheet1:B3 から事前に割り当てられた条件付き書式を取得し、生成されたピボットテーブル レポートで使用されているすべてのセルに適用する必要があります。だから私が問題を抱えている2つの部分があります。1 つ目は、レポートの使用範囲を見つけることです。2 つ目は、フォーマットを取得してそれらのセルに適用することです。エラーのある 3 つのスポットは、「動作しません」とマークされています

    Sub CreatePivot()
        ' Define RngTarget and RngSource as Range type variables
        Dim RngTarget As Range
        Dim RngSource As Range
        Dim intLastCol As Integer
        Dim intLCPivot As Integer
        Dim intLRPivot As Integer
        Dim intCntrCol As Integer
        Dim intX, intY As Integer
        Dim ws1, ws2 As Worksheet
        Dim pt As PivotTable
        Dim strHeader As String
        Dim cf As FormatCondition

        Set ws1 = ThisWorkbook.Sheets("Sheet1")
        Set ws2 = ThisWorkbook.Sheets("Sheet2")
        ws2.Cells.Clear

        ' RngTarget is where the PivotTable will be created (ie: Sheet2, Cell B3)
        Set RngTarget = ws2.Range("B3")
        'Set RngTarget = ThisWorkbook.Worksheets("Sheet2").Range("B3")

        ' RngSource defines the Range that will be used to create the PivotTable
        ' ActiveWorkbook = The currently opened Workbook
        ' ActiveSheet = The currectly opened sheet
        ' UsedRange = The Range of cells with active data in them
        Set RngSource = ws1.UsedRange

        ' Copy the Range into the clipboard
        RngSource.Copy

        ' Create a new PivotTable using the RngSource defined above,
        ' in Excel format,
        ' placed at the RngTarget location,
        ' And name it PivotB3 just for reference if needed
        ActiveWorkbook.PivotCaches.Create(xlDatabase, RngSource).CreatePivotTable RngTarget, "PivotB3"
        Set pt = RngTarget.PivotTable

        ' Get the last used column from the data table
        intLastCol = RngSource.Columns(RngSource.Columns.Count).Column

        ' Add all columns to the report
        ws2.Select
        With ActiveSheet.PivotTables("PivotB3").PivotFields("RECORDTYPE")
            .Orientation = xlRowField
            .Position = 1
        End With
        For intX = 3 To intLastCol
            strHeader = ws1.Cells(3, intX).Value
            ActiveSheet.PivotTables("PivotB3").AddDataField ActiveSheet.PivotTables("PivotB3").PivotFields(strHeader), "Sum of " & strHeader, xlSum
        Next intX

    '' DOES NOT WORK
        ' Get the last used row and column from the generated pivottable report so that conditional formatting
        ' can be applied to each used cell
        intLCPivot = pt.DataBodyRange.Columns(pt.DataBodyRange.Columns.Count).Column
        intLRPivot = pt.DataBodyRange.Rows(pt.DataBodyRange.Rows.Count).Row

        ' Select the Pivot table so we can apply the conditional formats
        pt.PivotSelect "", xlDataAndLabel, True

    '' DOES NOT WORK
        ' Get the conditional format from Sheet1:B3 and apply it to all used cells in the pivottable
        'cf = ws1.Range("B3").FormatCondition

        ws2.Select
        For intX = 2 To intLCPivot
            For intY = 5 To intLRPivot
                ws2.Cells(intY, intX).Select ' Select the current Sum column
    '' DOES NOT WORK
                'Selection.FormatConditions.Add cf

                Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="=5000" ' Set conditional format to less than 5000
                Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority ' Take priority over any other formats
                With Selection.FormatConditions(1).Font ' Use the Font property for the next operations
                    .ThemeColor = xlThemeColorLight1 ' Set it to the default (if it does not meet the condition)
                    .TintAndShade = 0 ' Same as above
                End With
                With Selection.FormatConditions(1).Interior
                    .PatternColorIndex = xlAutomatic
                    .Color = 65535 ' Set the background color to Yellow
                    .TintAndShade = 0
                End With
                Selection.FormatConditions(1).StopIfTrue = False
            Next intY
        Next intX
    End Sub
4

1 に答える 1

0

最後の質問に基づいて、フォーマットを適用するためのこの方法を提案します。

Set ws2 = ThisWorkbook.Sheets("Sheet2")
With ws2.UsedRange
    .FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="=5000" ' Set conditional format to less than 5000
    .FormatConditions(.FormatConditions.Count).SetFirstPriority ' Take priority over any other formats
    With .FormatConditions(1).Font ' Use the Font property for the next operations
        .ThemeColor = xlThemeColorLight1 ' Set it to the default (if it does not meet the condition)
        .TintAndShade = 0 ' Same as above
    End With
    With .FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535 ' Set the background color to Yellow
        .TintAndShade = 0
    End With
    .FormatConditions(1).StopIfTrue = False
End With

条件付き書式がコピーされたセルがある場合のコメントに基づいて:

ws1.[B3].Copy
ws2.UsedRange.PasteSpecial Paste:=xlPasteFormats

また、ヘッダーを削除する必要がある場合、これは困難ですが、ヘッダーの数と最初の列がわかっている場合は、このoffset方法が役立ちます。

With ws2.UsedRange
    Dim c1 As Range, c2 As Range
    Set c1 = .Cells(1).Offset(2, 1) '<~~ 2 rows down and 1 column in
    Set c2 = .Cells(.Cells.Count).Offset(-1) '<~~ 1 row up
End With

With ws2.Range(c1, c2)
    '<~~ add conditions here
end with
于 2013-05-04T03:21:53.557 に答える