我有一段代码可以让我找到F列中的下一个空闲单元格,操作员将输入一个权重。
我想帮助突出显示接近需要输入的范围内的单元格(这可以帮助检查条目是否正确而不进行过滤)。
我可以使用下面的代码执行此操作,但我尝试在写入单元格后删除突出显示并且我失败了。我尝试了一种方法' Do Until'但也不尽如人意。代码会运行,但一旦用户添加值,它就不会删除突出显示。
我也尝试过使用Wait函数,但它们完全冻结了Excel(我无法修改任何值)。另外,当我在调试中运行并使用随机迭代来修改Cell值时,我的代码可以工作。
'Find the last non-blank cell in column F (aka, column 6)
' We will add i rows to make the ith blank (in the for loop)
PreFree = Cells(Rows.Count, 6).End(xlUp).Row
NextFree = PreFree + 1
' Select Cell for manual input
Range("F" & NextFree).Select
'Do Until emptyWeight = False
If ThisWorkbook.Sheets("Input").Range("F" & NextFree) = "" Then
emptyWeight = True
Range(Cells(NextFree, "C"), Cells(NextFree, "F")).Interior.Color = RGB(181, 244, 0)
Else
Range(Cells(NextFree, "C"), Cells(NextFree, "F")).Interior.Color = RGB(255, 255, 255)
emptyWeight = False
End If
答案 0 :(得分:0)
正如BruceWayne爵士所说,你可以用Worksheet_Change
事件做到这一点。
Private Sub Worksheet_Change(ByVal Target As Range)
' Declare and prepare the intersection & union of ranges
Dim rIntersect As Range
Set rIntersect = Intersect(Target.Offset(1, 0), Sheets("YourSheet").Range("F:F"))
' Exit this event if there is no change in column f
If rIntersect Is Nothing Then Exit Sub
' Include TargetCell
Set rIntersect = Union(Target, rIntersect)
' Declare the 'each range', in case the user will paste values into column f
Dim rEach As Range
' Will loop through each cell that made a change in column f
For Each rEach In rIntersect
' Give default color.
rEach.Interior.Color = RGB(255, 255, 255)
' And test if the value <blank>, sets color if it is true.
If rEach.Value = "" Then rEach.Interior.Color = RGB(181, 244, 0)
Next
End Sub
希望这适合你。祝好运!