Question

有没有办法复制使用下面公式拉出的有条件格式化单元格的确切色调？

=LARGE(A:A,1)

我从数百行中拉出前10名，每行都有一个非常特定的色调，显示另一个定量顺序，不同于我订购前10名的标准。

也许一个例子会更清楚：

                        **Pets Owned**   ` - `   **Maintenance Level**
  Dogs           ` - `  ` 450            ` - `     8 
  Cats           ` - `  ` 350            ` - `     4
  Fish           ` - `  ` 150            ` - `     6
  Birds          ` - `  ` 100            ` - `     3
  Iguanas        ` - `  ` 5              ` - `     14

有条件地按B列格式化，颜色范围从绿色到红色

假设我想在保留B列的原始格式的同时，只拉出最高3位维护宠物，所以我想看到的是：

维护级别

14 {Red}       [Iguanas]
8 {Dark Green} [Dogs]
6 {Yellow}     [Fish]

图例：期望值，{color}，[通过相邻列的匹配/索引获得的相应动物]

对不起这张照片，但是对于截图来说，Windows是一个绝对的笑话（将xml转换为jpg的步数为6+？）

Answer 1

如果您使用的是Excel 2010或更高版本，则可以使用Cell的DisplayFormat属性对VBA执行此操作。

我使用的是简单的过滤器，而不是公式，但您也可以使用公式。

我添加了一个名为MaintRank的列，其中包含公式

=RANK(C2,$C$2:$C$6)

然后，例如，如果我想要前三名，我只会过滤1，2和3

然后使用VBA将其复制到某个新目的地。您可以将以下代码中的rResults更改为您想要的任何位置。

您可能还需要根据实际数据调整rTable

Option Explicit
Sub CopyVisibleWithCFColor()
    Dim rData As Range, rResults As Range
    Dim wsData As Worksheet, wsResults As Worksheet
    Dim C As Range
    Dim I As Long, J As Long

Set wsData = Worksheets("sheet1")
Set wsResults = Worksheets("sheet2")

With wsData
    Set rData = .Range(.Cells(1, 1), .Cells(.Rows.Count, "D").End(xlUp))
End With
Set rResults = wsResults.Cells(1, 1)

Set rData = rData.SpecialCells(xlCellTypeVisible)

rResults.Resize(columnsize:=rData.Columns.Count).EntireColumn.Clear
Set rResults = rResults(1)

rData.Copy rResults

Application.CutCopyMode = False

Set rResults = rResults.CurrentRegion
rResults.EntireColumn.ClearFormats
J = 0
For I = 1 To rData.Areas.Count
    For Each C In rData.Areas(I).Columns(2).Cells
        Debug.Print C.Address
        J = J + 1
        rResults.Rows(J).Interior.Color = C.DisplayFormat.Interior.Color
    Next C
Next I

End Sub

在下面的屏幕截图中，您可以在Sheet1上查看原始数据，并在Sheet2上查看复制的结果。在sheet1上，我选择返回排名为2,4和5的项目，在sheet2上，宏也在整行中着色。显然你可以改变它，如果你不需要它，你也不需要复制“rank”列。

Answer 2

如果我没弄错的话，OP想要这样：

如果您想使用Excel VBA，我的解决方案很糟糕......

它意味着建立自己的＆＃34;颜色格式＆＃34;功能在VBA :) makeColor

Public Function makeColor(ByVal x As Integer, ByVal min As Integer, ByVal max As Integer)
    Dim r As Integer, g As Integer, b As Integer
    ' you  must fine-tune the cases as you like
    b = 0
    If (x < (min + max) / 2) Then
      r = 255
      g = 0
    Else
      g = 255
      r = 0
    End If
    makeColor = RGB(r, g, b)
End Function

说你的数据是＆＃34;颜色＆＃34;标签和支架的范围（B1：B5）;硬编码值＆＃34; 0＆＃34;和＆＃34; 500＆＃34;表示数据中的最小值和最大值，也必须以编程方式定义：

Public Sub cpyColor()
    Dim wkRange As Range
    Dim c As Range        
    Set wkRange = ThisWorkbook.Sheets("color").Range("$B$1:$B$5")
    For Each c In wkRange
      c.Interior.Color = makeColor(c.Value, 0, 500)
      c.Offset(0, 1).Interior.Color = c.Interior.Color
    Next
End Sub

我的2个makeColor函数给出了：

Answer 3

我不认为没有VBA就可以完成，但作为替代方案，您可以更改目标的条件格式规则以匹配源的条件格式规则

数据拉回源条件格式

3 个答案: