Vba msgbox 只显示一次答案

【问题标题】：Vba msgbox show only onceVba msgbox 只显示一次
【发布时间】：2018-03-02 16:07:23
【问题描述】：

是否可以让这段代码的 msgbox 只出现一次？我的问题是，如果用户插入数据，即从第 501 行到第 510 行，消息框将出现 9 次，我只想拥有一次。这样做的原因是因为代码在每个单元格中查找以验证是否插入了某些内容，然后删除了内容并出现了 msg。如果可能的话，我想保留下面代码的格式，但只显示一次 msgbox。如果没有，欢迎提出任何建议。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell22 As Range

    Application.EnableEvents = False

    For Each cell22 In Target
        If Not Application.Intersect(cell22, Range("a501:z6000")) Is Nothing Then
            If cell22.Value <> "" Then
                cell22.ClearContents
                MsgBox "You cannot insert more than 500 rows", vbInformation, "Important:"
            End If
        End If

        Next cell22

        Application.EnableEvents = True

End Sub

【问题讨论】：

检查另一个替代方案（我的回答如下），它运行得更快
注意下面的其他答案，还要考虑在循环之前移动交叉检查的逻辑。
另外，你的逻辑说，如果单元格不为空，则清除它。换句话说，您的最终结果是所有单元格都是空的。您可以设置范围并一击清除，类似于 Shai 提到的但没有循环。

标签： vba excel

【解决方案1】：

我会建议另一种方式。

访问工作表的任务（例如ClearContents）需要更长的时间来处理。

因此，不要每次都在单个单元格的循环内清除内容，然后重复几百次，而是使用ClrRng 作为Range 对象。每次满足 If 条件时，使用 Application.Union 函数将其添加到 ClrRng。

完成循环遍历所有单元格后，同时清除 ClrRng 中的所有单元格。

代码

Private Sub Worksheet_Change(ByVal Target As Range)

Dim cell22 As Range, b As Boolean
Dim ClrRng As Range  ' define a range to add all cells that will be cleared

Application.EnableEvents = False

For Each cell22 In Target
    If Not Application.Intersect(cell22, Range("A501:Z6000")) Is Nothing Then
        If cell22.Value <> "" Then
            If Not ClrRng Is Nothing Then
                Set ClrRng = Application.Union(ClrRng, cell22)
            Else
                Set ClrRng = cell22
            End If
        End If
    End If
Next cell22

If Not ClrRng Is Nothing Then ' make sure there is at least 1 cell that passed the If criteria 
    ClrRng.ClearContents ' clear all cell's contents at once
    MsgBox "You cannot insert more than 500 rows", vbInformation, "Important:"
End If

Application.EnableEvents = True

End Sub

【讨论】：

【解决方案2】：

试试这个：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim cell22 As Range

    Application.EnableEvents = False

    For Each cell22 In Target

        If Not Application.Intersect(cell22, Range("a501:z6000")) Is Nothing Then

            If cell22.Value <> "" Then

                cell22.ClearContents

                GoTo displayMsg

            End If
        End If

    Next cell22
    Application.EnableEvents = True

    Exit Sub

displayMsg:

    MsgBox "You cannot insert more than 500 rows", vbInformation, "Important:"
    Application.EnableEvents = True


End Sub

【讨论】：

【解决方案3】：

这只会显示一次，但会清除每个非空白单元格。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim cell22 As Range, b As Boolean

Application.EnableEvents = False

For Each cell22 In Target
    If Not Application.Intersect(cell22, Range("a501:z6000")) Is Nothing Then
        If cell22.Value <> "" Then
            cell22.ClearContents
            b = True
        End If
    End If
Next cell22

If b Then MsgBox "You cannot insert more than 500 rows", vbInformation, "Important:"

Application.EnableEvents = True

End Sub

【讨论】：