遍历单元格以识别是否选择了数据验证列表

Question

我有一个宏，如果左侧的单元格表示已交付并且偏移量单元格为空白，则该宏会更改单元格的颜色（Offset（0,1））。宏是由数据验证列表中的更改触发的。见下文。但是，代码没有按照我的意愿进行。每次选择数据验证列表时，它不会运行。我希望每次在W列中更改数据验证选项时都运行此命令。（验证列表适用于W列中的所有单元格）。

代码可以工作，但是它在工作表中运行宏的方式发生了变化。

宏本身

Sub ConditionalFormatSharepointDeliveryLink()

Dim Lastrow As Long, n As Long, cell As Range, ws As Worksheet
Lastrow = Sheets("Sub Tasks").Range("W" & Rows.Count).End(xlUp).Row

n = 4

    For Each cell In Worksheets("Sub Tasks").Range("W4:W" & Lastrow)
        If cell.value = "Delivered" And cell.Offset(0, 1).value = "" Then
            cell.Offset(0, 1).Interior.Color = vbRed
        End If
    n = n + 1
    Next cell

End Sub

我如何调用宏

Private Sub Worksheet_Change(ByVal Target As Range)


Dim Lastrow As Long, n As Long, cell As Range, ws As Worksheet
Lastrow = Sheets("Sub Tasks").Range("W" & Rows.Count).End(xlUp).Row

For Each cell In Worksheets("Sub Tasks").Range("W4:4" & Lastrow)
    If Target.Address(True, True) = cell Then
        Select Case Target
            Case "Delivered"
                Call ConditionalFormatSharepointDeliveryLink
        End Select
    End If

End Sub
``````````````````````````` 




[![enter image description here][1]][1]


  [1]: https://i.stack.imgur.com/BJzZB.png

Answer 1

我看不到第二个子项的需要（但是如果您想保留用于其他目的，则可以离开，尽管您应该添加范围参数）。

检查Target与W列之间的交点，然后仅在有东西的情况下运行代码（此联机上有很多内容）。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Lastrow As Long, cell As Range
Lastrow = Sheets("Sub Tasks").Range("W" & Rows.Count).End(xlUp).Row

If Not Intersect(Target, Range("W4:W" & Lastrow)) Is Nothing Then
    For Each cell In Intersect(Target, Range("W4:W" & Lastrow))
        If cell.Value = "Delivered" And cell.Offset(0, 1).Value = vbNullString Then
            cell.Offset(0, 1).Interior.Color = vbRed
            'ConditionalFormatSharepointDeliveryLink
        End If
    Next cell
End If

End Sub

---

请注意，您可以使用条件格式进行所有操作。

Answer 2

这完全可以做到没有像这样的循环：

Private Sub Worksheet_Change(ByVal Target As Range)
lastrow = Sheets("Sub Tasks").Range("W" & Rows.Count).End(xlUp).Row
If Target.Value = "Delivered" Then
    If Application.Intersect(Target, Range("W4:W" & lastrow)) Is Nothing Then     Exit Sub
    Call ConditionalFormatSharepointDeliveryLink
End If
End Sub

根据您对其他答案的评论，您可能希望将此子项更改为Worksheet_Change。当单元格更改为“已交付”时，将运行该命令，但是只有在名称中选择了“已交付”的新单元格时，以上操作才会运行。