有条件的格式化可靠的报告 [英] Conditional formatting a pivottable report

问题描述

我需要从Sheet1：B3获取预先分配的条件格式，并将其应用于生成的数据透视表报表中的所有使用的单元格。所以有两个部分，我有一个问题。首先会发现报告的使用范围，第二个是获取格式并将其应用于这些单元格。错误的3个点被标记为不工作

  Sub CreatePivot（）
'定义RngTarget和RngSource作为范围类型变量
 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 
 
设置ws1 = ThisWorkbook.Sheets（Sheet1）
设置ws2 = ThisWorkbook.Sheets（Sheet2）
 ws2.Cells.Clear 
 
'RngTarget是将创建数据透视表（即：Sheet2，单元格B3）
设置RngTarget = ws2.Range（B3）
'设置RngTarget = ThisWorkbook.Worksheets（Sheet2）。范围（B3 ）
 
'RngSource定义th e将用于创建PivotTable的范围
'ActiveWorkbook =当前打开的工作簿
'ActiveSheet =正确打开的工作表
'UsedRange =其中包含活动数据的单元格范围
设置RngSource = ws1.UsedRange 
 
'将范围复制到剪贴板
 RngSource.Copy 
 
'使用上面定义的RngSource创建一个新的数据透视表，
'以Excel格式，
'放置在RngTarget位置，
'并命名为PivotB3仅供参考（如果需要）
 ActiveWorkbook.PivotCaches.Create（xlDatabase，RngSource）.CreatePivotTable RngTarget ，PivotB3
设置pt = RngTarget.PivotTable 
 
'从数据表中获取最后使用的列
 intLastCol = RngSource.Columns（RngSource.Columns.Count）.Column 
 
'将所有列添加到报表中
 ws2.Select 
使用Act iveSheet.PivotTables（PivotB3）。PivotFields（RECORDTYPE）
 .Orientation = xlRowField 
 .Position = 1 
结束
对于intX = 3到intLastCol 
 strHeader = ws1.Cells（3，intX）.Value 
 ActiveSheet.PivotTables（PivotB3）。AddDataField ActiveSheet.PivotTables（PivotB3）。PivotFields（strHeader），Sum of& strHeader，xlSum 
下一个intX 
 
''不工作
'从生成的可枢转报表中获取最后使用的行和列，以便条件格式
'可以应用于每个使用的单元格
 intLCPivot = pt.DataBodyRange.Columns（pt.DataBodyRange.Columns.Count）.Column 
 intLRPivot = pt.DataBodyRange.Rows（pt.DataBodyRange.Rows.Count）.Row 
 
'选择数据透视表，以便我们可以应用条件格式
 pt.PivotSelect，xlDataAndLabel，True 
 
''DOES NOT WORK 
'从Sheet1：B3获取条件格式，并将其应用于pivotottable 
'cf = ws1.Range（B3）中的所有使用的单元格。FormatCondition 
 
 ws2.Select 
对于intX = 2对于intLCPivot 
对于intY = 5到intLRPivot 
 ws2.Cells（intY，intX）。选择'选择当前Sum列
''不工作
 'Selection.FormatConditions.Add cf 
 
 Selection.FormatConditions.Add类型：= xlCellValue，运算符：= xlLess，Formula1：== 5000'将条件格式设置为小于5000 
选择.FormatConditions（Selection.FormatConditions.Count）.SetFirstPriority'优先于任何其他格式
 With Selection.FormatConditions（1）.Font'对下一个操作使用Font属性
 .ThemeColor = xlThemeColorLight1'Set它到默认值（如果不符合条件）
 .TintAndShade = 0'与上述相同
结束与
与Selection.FormatConditions（1）.Interior 
 .PatternColorIndex = xlAutomatic 
 .Color = 65535'将背景颜色设置为黄色
 .TintAndShade = 0 
结束
 Selection.FormatConditions（1）.StopIfTrue = Fals e 
下一个intY 
下一个intX 
 End Sub 
  

解决方案

根据您最后一个问题，我提出了应用格式的方法： p>

 设置ws2 = ThisWorkbook.Sheets（Sheet2）
带有ws2.UsedRange 
 .FormatConditions.Add类型：= xlCellValue，运算符：= xlLess，Formula1：== 5000'将条件格式设置为小于5000 
 .FormatConditions（.FormatConditions.Count）.SetFirstPriority'优先于任何其他格式
 With .FormatConditions（1）.Font'为下一个操作使用Font属性
 .ThemeColor = xlThemeColorLight1'将其设置为默认值（如果不符合条件）
 .TintAndShade = 0'与以上
结束
 With .FormatConditions（1）.Interior 
 .PatternColorIndex = xlAutomatic 
 .Color = 65535'将背景颜色设置为黄色
 .TintAndShade = 0 
结束
 .FormatConditions（1）.StopIfTrue = False 
结束
  

根据评论，如果您有一个单元格的条件格式复制：

  ws1。[B3] .Copy 
 ws2.UsedRange.PasteSpecial粘贴：= xlPasteFormats 
  / pre> 
 
 
 另外如果你需要删除标题这将是困难的，但如果头文件数量和第一列已知的 offset 方法将有助于：
 使用ws2.UsedRange 
 Dim c1作为范围，c2 As Range 
设置c1 = .Cells（1）.Offset（2，1）'<〜〜2行向下和
中的1列设置c2 = .Cells（.Cells）。计数）.Offset（-1）'<〜〜1 row up 
 End with 
 
带有ws2.Range（c1，c2）
'< ~~添加条件这里
结束
  
 
I need to get the pre-assigned conditional format from Sheet1:B3 and apply it to all used cells in a generated PivotTable report. So there are two parts that I am having a problem with. First would be finding out the usedrange for the report, and the second is getting the format and applying it to those cells. The 3 spots with errors are marked with '' DOES NOT WORK
    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

解决方案
Based on you last question I propose this method for applying your formatting:
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
Based on comment if you have a cell that has the conditional formatting copy it over:
ws1.[B3].Copy
ws2.UsedRange.PasteSpecial Paste:=xlPasteFormats
Also if you need to remove the headers this will be difficult but if the number of headers and first columns in known the offset method will help:
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


                        
这篇关于有条件的格式化可靠的报告的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！