在继续之前检查范围中的值

Question

所以现在我有一个excel工作簿作为任务跟踪器。当包含已完成日期的列被填写时，它将把这一行复制到另一个工作表("完成")，然后将其从当前工作表("当前")中删除。在执行之前，我想让它做的是检查列H到M的值是否为C或U。如果该区域中的任何单元格不包含或，那么我希望它退出并显示一条消息。我对Excel或VBA不太熟悉，但对c++还不错。

下面是目前的代码:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim receivedDate As Range, nextOpen As Range, isect As Range
Set receivedDate = Sheet1.Range("G3:G166")
Set isect = Application.Intersect(Target, receivedDate)
If Not (isect Is Nothing) And IsDate(Target) = True Then
    Set nextOpen = Sheet4.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    Target.EntireRow.Copy Destination:=nextOpen.EntireRow
    Target.EntireRow.Delete
End If
Application.EnableEvents = True
End Sub

这是我所做的剪辑…

工作片段

任何帮助都将非常感激。对不起，我试着四处看看。

Answer 1

Edit -更健壮，添加错误处理程序和多单元格更新处理

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim receivedDate As Range, nextOpen As Range, isect As Range
    Dim rngHM As Range, c As Range, rngDel As Range
    Set receivedDate = Sheet1.Range("G3:G166")
    'are any of the changed cells in the range we're monitoring?
    Set isect = Application.Intersect(Target, receivedDate)
    On Error GoTo haveError 'error handler ensures events get re-enabled...
    '### remember that Target can contain >1 cell...
    For Each c In isect.Cells
        If IsDate(c.Value) Then
            With c.EntireRow
                Set rngHM = .Cells(1, "H").Resize(1, 6)
                'EDIT: all cells must be C or U
                If (Application.CountIf(rngHM, "C") + _
                   Application.CountIf(rngHM, "U")) <> rngHM.Cells.Count Then
                    MsgBox "No C or U on row " & c.Row & " !"
                Else
                    Set nextOpen = Sheet4.Range("A" & Rows.Count) _
                                      .End(xlUp).Offset(1, 0)
                    .Copy Destination:=nextOpen.EntireRow
                    'deleting rows while looping gives odd results,
                    '  so store them up until done...
                    If rngDel Is Nothing Then
                        Set rngDel = c
                    Else
                        Set rngDel = Application.Union(rngDel, c)
                    End If
               End If
            End With 'entirerow
        End If   'is date
    Next c
    'delete any copied rows in a single operation
    If Not rngDel Is Nothing Then
        Application.EnableEvents = False
        rngDel.EntireRow.Delete
        Application.EnableEvents = True
    End If
    Exit Sub
haveError:
    'if your code errors out then this makes sure event handling gets reset
    Application.EnableEvents = True
End Sub