Fatal编程技术网
  • vba/
  • Vba 继续之前，请检查范围内的值

Vba 继续之前，请检查范围内的值

vba excel

Vba 继续之前，请检查范围内的值,vba,excel,range,Vba,Excel,Range,所以现在我有一个任务跟踪器的excel工作簿。填写包含完成日期的列后，它将获取该行并将其复制到另一个工作表（“完成”），然后将其从当前工作表（“当前”）中删除。在执行此操作之前，我希望它检查H列到M列的值是否为“C”或“U”。如果该区域中的任何单元格不包含或，则我希望它退出并显示一条消息。我不是很熟悉Excel或VBA，但对C++有很好的了解。 以下是截至目前的代码： Private Sub Worksheet_Change(ByVal Target As Range) Application

所以现在我有一个任务跟踪器的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
这是我正在做的事情的剪报

任何帮助都将不胜感激。抱歉，我试着四处看看。

编辑-更健壮，添加了错误处理程序和多单元更新处理

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

Private子工作表\u更改（ByVal目标作为范围）
Dim接收数据作为范围，nextOpen作为范围，isect作为范围
变暗rngHM As范围、c As范围、rngDel As范围
设置接收日期=表1.范围（“G3:G166”）
“在我们监控的范围内是否有任何变化的单元格？”？
Set isect=Application.Intersect（目标，接收日期）
在错误转到haveError时，错误处理程序确保重新启用事件。。。
“####记住，目标可以包含>1个单元格。。。
对于每一个解剖细胞中的c
如果是IsDate（c值），则
用c.EntireRow
设置rngHM=.Cells（1，“H”）。调整大小（1,6）
'编辑：所有单元格必须是C或U
If（Application.CountIf（rngHM，“C”）+_
Application.CountIf（rngHM，“U”））rngHM.Cells.Count Then
MsgBox“第行没有C或U”&第行和“！”
其他的
设置nextOpen=Sheet4.Range（“A”和Rows.Count）_
.结束（xlUp）.偏移量（1,0）
.Copy Destination:=nextOpen.EntireRow
'循环时删除行会产生奇数结果，
“所以把它们储存起来直到完成。。。
如果rngDel什么都不是，那么
设置rngDel=c
其他的
Set rngDel=Application.Union（rngDel，c）
如果结束
如果结束
以“entirerow”结尾
“如果”是日期，则结束
下一个c
'在单个操作中删除所有复制的行
如果不是，那么rngDel什么都不是
Application.EnableEvents=False
rngDel.EntireRow.Delete
Application.EnableEvents=True
如果结束
出口接头
haveError：
'如果您的代码出错，那么这将确保事件处理得到重置
Application.EnableEvents=True
端接头
编辑-更健壮，添加了错误处理程序和多单元更新处理

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

Private子工作表\u更改（ByVal目标作为范围）
Dim接收数据作为范围，nextOpen作为范围，isect作为范围
变暗rngHM As范围、c As范围、rngDel As范围
设置接收日期=表1.范围（“G3:G166”）
“在我们监控的范围内是否有任何变化的单元格？”？
Set isect=Application.Intersect（目标，接收日期）
在错误转到haveError时，错误处理程序确保重新启用事件。。。
“####记住，目标可以包含>1个单元格。。。
对于每一个解剖细胞中的c
如果是IsDate（c值），则
用c.EntireRow
设置rngHM=.Cells（1，“H”）。调整大小（1,6）
'编辑：所有单元格必须是C或U
If（Application.CountIf（rngHM，“C”）+_
Application.CountIf（rngHM，“U”））rngHM.Cells.Count Then
MsgBox“第行没有C或U”&第行和“！”
其他的
设置nextOpen=Sheet4.Range（“A”和Rows.Count）_
.结束（xlUp）.偏移量（1,0）
.Copy Destination:=nextOpen.EntireRow
'循环时删除行会产生奇数结果，
“所以把它们储存起来直到完成。。。
如果rngDel什么都不是，那么
设置rngDel=c
其他的
Set rngDel=Application.Union（rngDel，c）
如果结束
如果结束
以“entirerow”结尾
“如果”是日期，则结束
下一个c
'在单个操作中删除所有复制的行
如果不是，那么rngDel什么都不是
Application.EnableEvents=False
rngDel.EntireRow.Delete
Application.EnableEvents=True
如果结束
出口接头
haveError：
'如果您的代码出错，那么这将确保事件处理得到重置
Application.EnableEvents=True
端接头

u/C++比VBA复杂得多。如果你可以C++，你可以在你的睡眠中VBA。也就是说，谷歌<代码>查找。UHC++比VBA复杂得多。如果你可以C++，你可以在你的睡眠中VBA。也就是说，谷歌
find
。这太棒了，喜欢它。但是，如果可能的话，它能检查H到M列吗？到目前为止，这只检查“H”。不知道如何编辑它的剩余部分？！非常感谢你的帮助
Set rngHM=c.EntireRow.Cells（1，“H”）.Resize（1,6）
（用
展开
）将
rngHM
设置为
c
所在行的H列，然后使用Resize（）将其扩展到1行x 6列的范围。这涵盖了该行上的H:M，作为替代方法，Set rngHM=c.EntireRow.Range（“H1:M1”）
将实现相同的效果，但当我运行它时，出于某种原因，它只检查第一列（“H”），而不检查其余列。有什么想法吗？还是我误解了你的意思？@MasonReiselt你是在计算只包含C/U的单元格还是其他字符中包含C/U的单元格？这太棒了，我喜欢。但是，如果可能的话，它能检查H到M列吗？到目前为止，这只检查“H”。不知道如何编辑它的剩余部分？！非常感谢你的帮助<代码>设置rngHM=c.EntireRow.Cells（1，“H”）。调整大小（1,6）
（用
展开
）