在继续

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

以下是我发生的事情......

snip of work

非常感谢任何帮助。对不起，我试着环顾一下。

Answer 1

修改 - 更强大，添加错误处理程序和多单元更新处理

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