在Excel vba中用户输入后更改突出显示颜色

时间:2017-05-23 01:17:33

标签: excel vba excel-vba if-statement while-loop

我有一段代码可以让我找到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

1 个答案:

答案 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

希望这适合你。祝好运!



要OP,请将代码粘贴到此处

enter image description here