有条件地格式化数据透视表中的唯一行，并将此格式传输到其他单元格而无需规则或值

问题描述 投票：0回答：3

我有一个数据透视表，总结了我们库存中每件商品在六周时间范围内的三个关键数据。

我想使用色标有条件地格式化每个单独项目的“供应商库存 DOH”行中的六个单元格。
一旦这六个单元格被格式化，我想将这些颜色复制到“总库存”中下面的协调六个单元格，而不需要通常带有格式的规则或值。
这样做的目的是通过颜色比例显示现有库存风险，与当前库存相协调 - 将其视为库存值之上的分层格式。

仅对于格式化过程，我发现了引用本文的类似相关讨论：Excel条件多行色阶，并且我尝试使用它包含在注释中的代码。我更改了代码及其引用以匹配我需要的内容 - 完全清楚该代码仅用于对所有数据进行全面拖放 - 而不是用于唯一的行本身。如果这段代码有效，我希望它至少是一个开始——但是在运行它之后它没有做任何事情。我想知道其中的某些代码是否不正确，我会添加什么样的代码来仅格式化具有供应商库存 DOH 描述的行，或者是否有更好的方法来执行此操作？ 对于复制格式部分，我找到了相关文章讨论：如何在不从条件格式单元格复制规则的情况下复制条件格式？，但是仅复制和粘贴颜色本身在我的 Windows 10 Excel 版本上不起作用。有没有办法也完成这个过程？

原始版本代码：

Option Explicit
Sub ApplyConditionalFormatting()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") ' change to your sheet here
    Dim rw As Long
    Dim rng As Range

    For rw = 3 To 8 ' change to your respective rows
        With ws
            Set rng = .Range(.Cells(rw, "E"), .Cells(rw, "K")) ' change to your respective columns

            With rng
                .FormatConditions.AddColorScale ColorScaleType:=3
                .FormatConditions(.FormatConditions.Count).SetFirstPriority  ' now its index is 1, in case there already was cond formatting applied
            End With

            With rng.FormatConditions(1)
                With .ColorScaleCriteria(1)
                    .Type = xlConditionValueNumber
                    .Value = 0
                    .FormatColor.Color = 7039480
                End With

                With .ColorScaleCriteria(2)
                    .Type = xlConditionValueFormula
                    .Value = "='" & ws.Name & "'!$D$" & rw & "*3" ' References column D, change as needed
                    .FormatColor.Color = 8711167
                End With

                With .ColorScaleCriteria(3)
                    .Type = xlConditionValueFormula
                    .Value = "='" & ws.Name & "'!$D$" & rw & "*5" ' References column D, change as needed
                    .FormatColor.Color = 8109667
                End With
            End With
        End With
    Next rw
End Sub

我的代码版本：

Sub CF()
'
' CF Macro
'
' Keyboard Shortcut: Ctrl+f
'
End Sub

Public Sub Formatting()
Option Explicit
Sub ApplyConditionalFormatting()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet2")
    Dim rw As Long
    Dim rng As Range

    For rw = 6 To 1764
        With ws
            Set rng = .Range(.Cells(rw, "B"), .Cells(rw, "G"))

            With rng
                .FormatConditions.AddColorScale ColorScaleType:=3
                .FormatConditions(.FormatConditions.Count).SetFirstPriority
            End With

            With rng.FormatConditions(1)
                With .ColorScaleCriteria(1)
                    .Type = xlConditionValueNumber
                    .Value = 40
                    .FormatColor.Color = 7039480
                End With

                With .ColorScaleCriteria(2)
                    .Type = xlConditionValueFormula
                    .Value = 70
                    .FormatColor.Color = 8711167
                End With

                With .ColorScaleCriteria(3)
                    .Type = xlConditionValueFormula
                    .Value = 80
                    .FormatColor.Color = 8109667
                End With
            End With
        End With
    Next rw
End Sub
End Sub

我希望每个单独项目的行 DOH 根据我在自动化过程中所需的规则进行有条件格式化，该过程不包括使用格式刷逐行进行。然后，能够将这些颜色复制到下面的总库存单元格（没有规则或值），以便能够显示现有天数和库存剩余量之间的相关性。

带有规则的数据透视表： Pivot Table with Rule

具有所需格式的数据透视表： Pivot table with desired formatting

excel vba pivot-table conditional-formatting
3个回答
0
投票

您可以通过

PivotSelect
，
获取所有相关单元格 然后添加您想要的条件格式，
并将生成的 
DisplayFormat.Interior.Color
用作“总库存”单元格的 
Interior.Color
。

Private Sub ConditionalFormattingforSNCPlanning()
    Dim ws As Excel.Worksheet
    Dim pt As Excel.PivotTable
    Dim fc As Excel.FormatCondition
    Dim cs As Excel.ColorScale
    Dim strDOH As String, strTotal As String
    Dim rngSource As Range, rngDest As Range, rngCell As Range, strDest() As String

    Set ws = ActiveWorkbook.Sheets("Sheet2")
    Set pt = ws.PivotTables(1)
    strDOH = "'SNC PLANNING' 'Supplier Network DOH'"
    strTotal = "'SNC PLANNING' 'Total Inventory'"

    ' Delete all conditional colors and normal interior colors first
    With pt.TableRange2
        .FormatConditions.Delete
        .Interior.ColorIndex = xlNone
        .Interior.Pattern = xlNone
    End With

    ' Show all pivottable rows, as otherwise PivotSelect may fail
    Dim i As Long
    For i = pt.RowFields.Count To 2 Step -1
        pt.RowFields(i).ShowDetail = True
    Next i

    ' select all desired rows for conditional formatting
    pt.PivotSelect _
        Name:=strDOH, _
        Mode:=XlPTSelectionMode.xlDataOnly, _
        Usestandardname:=True

    ' if you don't want to delete every conditional format
    ' by above pt.TableRange2.FormatConditions.Delete
    ' then use following line here instead
    ' Selection.FormatConditions.Delete

    ' Add a new conditional formatting (3-Color Scale)
    Set cs = Selection.FormatConditions.AddColorScale(ColorScaleType:=3)
    With cs.ColorScaleCriteria(1)
        .Type = xlConditionValueNumber
        .Value = 40
        .FormatColor.Color = RGB(248, 105, 107) ' 7039480
        .FormatColor.TintAndShade = 0
    End With
    With cs.ColorScaleCriteria(2)
        .Type = xlConditionValueNumber
        .Value = 70
        .FormatColor.Color = RGB(255, 235, 132) ' 8711167
        .FormatColor.TintAndShade = 0
    End With
    With cs.ColorScaleCriteria(3)
        .Type = xlConditionValueNumber
        .Value = 80
        .FormatColor.Color = RGB(99, 190, 123) ' 8109667
        .FormatColor.TintAndShade = 0
    End With

    ' Get both ranges for later color-copy-code
    Set rngSource = Selection
    pt.PivotSelect _
        Name:=strTotal, _
        Mode:=XlPTSelectionMode.xlDataOnly, _
        Usestandardname:=True
    Set rngDest = Selection

    ' Exit if both range's cell count not equal
    If rngSource.Cells.Count <> rngDest.Cells.Count Then
        MsgBox "Sorry, this works only, if cell count is identical"
        Exit Sub
    End If

    ' store all addresses of the destination range's cells
    ReDim strDest(1 To rngDest.Cells.Count)
    i = 1
    For Each rngCell In rngDest.Cells
        strDest(i) = rngCell.AddressLocal
        i = i + 1
    Next rngCell

    ' copy source's DisplayFormat.Interior.Color
    ' to destination's Interior.Color
    ' cell by cell
    i = 1
    For Each rngCell In rngSource.Cells
        ws.Range(strDest(i)).Interior.Color = rngCell.DisplayFormat.Interior.Color
        i = i + 1
    Next rngCell
End Sub
0
投票

这是一种不同的方法，在 

PivotTable.RowRange
上循环。当找到所需的术语时，
PivotTable.DataBodyRange
的相应行会被着色。

“源”（例如“供应商网络 DOH”）通过条件格式进行格式化，“目标”（例如“总库存”）获取先前条件格式化行的显示颜色作为内部颜色。

Private Sub ConditionalFormattingforSNCPlanningVersion2()
    Dim ws As Excel.Worksheet
    Dim pt As Excel.PivotTable
    Dim fc As Excel.FormatCondition
    Dim cs As Excel.ColorScale
    Dim SourceString As String, DestString As String
    Dim SourceIsFound As Boolean
    Dim SourceRow As Long, DestRow As Long
    Dim CellInColumn As Range, CellInRow As Range

    Set ws = ActiveWorkbook.ActiveSheet
    Set pt = ws.PivotTables(1)
    SourceString = "Supplier Network DOH"
    DestString = "Total Inventory"

    ' Delete all conditional colors and normal interior colors first
    With pt.TableRange2
        .FormatConditions.Delete
        .Interior.ColorIndex = xlNone
        .Interior.Pattern = xlNone
    End With

    ' Show all pivottable rows
    Dim i As Long
    For i = pt.RowFields.Count To 2 Step -1
        pt.RowFields(i).ShowDetail = True
    Next i

    ' loop all cells in last column of rowrange
    For Each CellInColumn In pt.RowRange.Columns(pt.RowRange.Columns.Count).Cells

        ' If row is source, then add conditional formatting
        If CellInColumn.Value = SourceString Then
            SourceIsFound = True
            SourceRow = CellInColumn.Row
            Set cs = Intersect(ws.Rows(SourceRow).EntireRow, pt.DataBodyRange).FormatConditions.AddColorScale(ColorScaleType:=3)
            With cs.ColorScaleCriteria(1)
                .Type = xlConditionValueNumber
                .Value = 40
                .FormatColor.Color = RGB(248, 105, 107) ' 7039480
                .FormatColor.TintAndShade = 0
            End With
            With cs.ColorScaleCriteria(2)
                .Type = xlConditionValueNumber
                .Value = 70
                .FormatColor.Color = RGB(255, 235, 132) ' 8711167
                .FormatColor.TintAndShade = 0
            End With
            With cs.ColorScaleCriteria(3)
                .Type = xlConditionValueNumber
                .Value = 80
                .FormatColor.Color = RGB(99, 190, 123) ' 8109667
                .FormatColor.TintAndShade = 0
            End With
        End If

        ' If cell is destination, then copy color of previously found sourcerow
        If CellInColumn.Value = DestString Then
            If SourceIsFound Then
                DestRow = CellInColumn.Row
                For Each CellInRow In Intersect(ws.Rows(SourceRow).EntireRow, pt.DataBodyRange).Cells
                    ws.Cells(DestRow, CellInRow.Column).Interior.Color = CellInRow.DisplayFormat.Interior.Color
                Next CellInRow
                SourceIsFound = False
            End If
        End If

    Next CellInColumn
End Sub
0
投票

有什么办法可以排除总计列吗？？？预先感谢

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.