Excel 数据透视表的条件格式设置
我需要从Sheet1:B3中获取预先分配的条件格式,并将其应用于生成的数据透视表中所有使用的单元格。所以我有两个问题。第一个是找出报告的使用范围,第二个是获取格式并将其应用于这些单元格。有错误的3个点标记为“不工作”Excel 数据透视表的条件格式设置,excel,excel-2010,vba,Excel,Excel 2010,Vba,我需要从Sheet1:B3中获取预先分配的条件格式,并将其应用于生成的数据透视表中所有使用的单元格。所以我有两个问题。第一个是找出报告的使用范围,第二个是获取格式并将其应用于这些单元格。有错误的3个点标记为“不工作” Sub CreatePivot() ' Define RngTarget and RngSource as Range type variables Dim RngTarget As Range Dim RngSource A
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
基于您,我建议使用以下方法应用您的格式:
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
此外,如果需要删除标题,这将很困难,但如果已知的标题数和第一列数,则偏移量方法将有助于:
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
仅供参考,您的变量未正确声明。例如,Dim intX、intY As Integer仅将intY声明为Integer。intX未指定,因此它将是Variant类型。同样,下一行Dim ws1、ws2作为工作表,其中只有ws2被声明为工作表变量。干杯,哎呀!谢谢你,大卫。修正了。好的,这比嵌套的FOR-NEXT循环更干净。但唯一的问题是,实际公式可能会改变。正确的公式将始终在表1:B3中。但除此之外,我肯定更喜欢这种赋值方法。极限值在b3中?您可以将=5000更改为=&ws1。[B3]好的,不是限制值。但是B3将具有应用于数据透视表单元格的相同条件格式。所以B3会有公式、字体设置、图案和颜色。。。杰出的好的,最后一点挑剔的事。。。usedrange包含标题,因此背景是错误的。有没有一种快速的方法来改变这一点,或者我应该得到第一行和最后一行,然后用listheaderrows重新定义范围?是的!我更喜欢你的代码。我已经忘记了需要删除的专栏。再次感谢!这个项目现在完成了!呸