将特定的彩色单元格复制到不同的工作表上

我正在使用条件格式的电子表格，它将一些单元格变成绿色和红色，这取决于它们是否在正确的范围之内。

我需要的是将红色“超出规格”的数字复制到下一张纸上，而在第二张纸上留下绿色的“规格内”数字。 有点像这样：

第1页：

a2

b 4

c 5

d 6

e 3

第2页：

一个

b 4

c 5

d 6

Ë

我希望这是有道理的，我做了截图，但我不能张贴它们！ 我的手指交叉，有人可以帮助:)

提前感谢爵士乐

Answer 1

我假设数据在Sheet1的A列中。

经testing

Sub checkColornCopy() 

find自动化的最后一行

 lastRow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row sheet2Counter = 1 For i = 1 To lastRow 

提取单元格内部的颜色

 ConditionalColor = Worksheets("Sheet1").Cells(i, 1).Interior.ColorIndex 

颜色索引3表示“红色”

 If ConditionalColor = 3 Then 

如果颜色为红色，则将Sheet1的单元格内容复制到Sheet2

 Worksheets("Sheet2").Cells(sheet2Counter, 1).Value = Worksheets("Sheet1").Cells(i, 1).Value 

使Sheet1的单元格内容为空

 Worksheets("Sheet1").Cells(i, 1).Value = " " sheet2Counter = sheet2Counter + 1 End If Next End Sub 

Answer 2

这可能不是最好的办法，但它为我工作。
尝试：

 Dim i As Integer Dim cell As String Sheets("Sheet1").Activate For i = 1 To 10 'Check if font is red If Range("A" & i).Font.Color = "fontcolor" Then cell = Range("A" & i).Value 'Check for a number in the cell and remove the right most number While IsNumeric(Right(cell, 1)) cell = Range("A" & i).Value cell = Left(cell, Len(cell) - 1) Sheets("sheet2").Range("A" & i).Value = cell Wend Else 'If font is not red then display cell value on sheet2 Sheets("sheet2").Range("A" & i).Value = Sheets("sheet1").Range("A" & i).Value End If Next Sheets("Sheet2").Activate 

编辑
在这种情况下，“A3”有红色的字体。
要find你的红色字体的颜色使用：

 sub Text_Color() Dim color As String '"A3" has red text. color = Sheets("sheet1").Range("A3").Font.color MsgBox "My text color is= " & color End Sub 

以msgbox中的数字为例，在本例中为393372.并用393372代替上述代码中的“fontcolor”。