VBAmacros改变1秒的值的单元格的颜色

我正在从事Excel项目的工作，我正在处理生活中正在改变的价格，这些价格是从E栏和F栏的外部来源获得的。

我想要的是：

1. 当这些单元格更改值时，我希望它们将颜色从橙色更改为白色，或将单元格背景更改为白色
2. 我希望这只发生1秒或更less，并恢复到原来的单元格颜色或背景颜色

这样我可以保持我的眼睛价格，当他们改变。

这可能吗 ？

请帮忙。 谢谢

Answer 1

当E或F列中的任何单元格发生更改时，将其添加到您希望应用于其中的工作表的代码中（不在单独的模块中）1秒钟的颜色更改：

Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("E:F")) Is Nothing Then Target.Interior.ColorIndex = 2 Application.Wait (Now + #0:00:01#) Target.Interior.ColorIndex = 46 End If End Sub 

或者对于less于1秒的更改，使用下面的版本作为application.wait不处理时间任何比1秒更好，但timer 。

 Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("E:F")) Is Nothing Then Dim x As Single x = Timer While Timer - x < 0.5 Target.Interior.ColorIndex = 2 Wend Target.Interior.ColorIndex = 46 End If End Sub 

ColorIndex值为白色，默认橙色。 要更改为您要查找的特定颜色，请参阅http://dmcritchie.mvps.org/excel/colors.htm

编辑 – 下面的新答案。 上面的原始答案。

好吧，这是一个混乱的方式，但应该实现你想要做的。

将其粘贴到一个模块中，调整1到10，以覆盖您正在监视的单元格数量，以便进行更改：

 Public val(1 To 10) As Variant 

将其粘贴到您的ThisWorkbook代码区域，调整单元格引用，以便您正在观看的每个引用都包含在正确的升序中（E列从最低到最高，然后是F列从最低到最高）：

 Private Sub Workbook_Open() val(1) = Sheet1.Range("E1").Value val(2) = Sheet1.Range("E2").Value val(3) = Sheet1.Range("E3").Value val(4) = Sheet1.Range("E4").Value val(5) = Sheet1.Range("E5").Value val(6) = Sheet1.Range("F1").Value val(7) = Sheet1.Range("F2").Value val(8) = Sheet1.Range("F3").Value val(9) = Sheet1.Range("F4").Value val(10) = Sheet1.Range("F5").Value End Sub 

最后，将其粘贴到工作表的代码区域，使用您正在监视的值进行更改，再次调整范围以适应您的手表范围：

 Private Sub Worksheet_Calculate() Dim x As Single, colIndx As Integer i = 1 For Each cell In Range("E1:E5") If cell.Value <> val(i) Then colIndx = cell.Interior.ColorIndex x = Timer While Timer - x < 0.5 cell.Interior.ColorIndex = 2 Wend cell.Interior.ColorIndex = colIndx val(i) = cell.Value End If i = i + 1 Next cell For Each cell In Range("F1:F5") If cell.Value <> val(i) Then colIndx = cell.Interior.ColorIndex x = Timer While Timer - x < 0.5 cell.Interior.ColorIndex = 2 Wend cell.Interior.ColorIndex = colIndx val(i) = cell.Value End If i = i + 1 Next cell End Sub 

最后保存并closures你的工作簿并重新打开它，希望颜色应该随着值更新。