数据拉回来源条件格式

有没有办法复制一个有条件格式化的单元格使用下面的公式拉的精确色调?

=LARGE(A:A,1)

我从数百行中抽出了前十名,每一个都有一个非常特殊的色调,这个色调显示出另一个定量的顺序,与我订购前十名的标准不同。

也许一个例子会更清楚:

  **Pets Owned** ` - ` **Maintenance Level** Dogs ` - ` ` 450 ` - ` 8 Cats ` - ` ` 350 ` - ` 4 Fish ` - ` ` 150 ` - ` 6 Birds ` - ` ` 100 ` - ` 3 Iguanas ` - ` ` 5 ` - ` 14 
  • 由B列有条件地格式化,从绿色到红色的比例

比方说,我只想拉动前三名维护宠物,同时保持B列的原始格式,所以我想看到的是:

维护水平

 14 {Red} [Iguanas] 8 {Dark Green} [Dogs] 6 {Yellow} [Fish] 
  • 图例:所需值,{颜色},[通过相邻列上的匹配/索引获得的对应动物]

最右边的列颜色需要匹配最左边的cond。形成。颜色

抱歉的照片,但窗口是一个绝对的笑话截图(6 +步骤将XML转换为JPG?!)

如果您有Excel 2010或更高版本,则可以使用单元格的DisplayFormat属性在VBA中执行此操作。

我使用了一个简单的filter,而不是公式,也可以使用公式。

我添加了一个带有公式的MaintRank列

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

然后,例如,如果我想要前三名,我只是过滤123

然后使用VBA将其复制到新的目的地。 您可以在下面的代码rResults更改为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上的复制结果。 在工作表1上,我select返回排名2,4和5的项目,而在工作表2上,macros也在整个行中着色。 显然你可以改变它,如果你不需要的话,你也不需要复制“等级”列。

在这里输入图像说明

如果我没有弄错,OP想要这个: 在这里输入图像说明

如果你想玩Excel VBA,我有一个可怜的解决scheme…

它意味着在VBA中build立自己的“颜色格式”function:) 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 

说你的数据是在“颜色”选项卡,并在范围内(B1:B5); 硬编码值“0”和“500”代表数据中的最小值和最大值,并且也必须以编程方式定义:

 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例makeColorfunction,它给:

在这里输入图像说明

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

在这里输入图像说明