VBA msgbox仅显示一次

Question

是否可以使此代码的msgbox仅出现一次？ 我的问题是，如果用户从行501到510插入数据，则该消息框将出现9次，而我只希望有一次。 这是因为该代码在每个单元格中查找以验证是否插入了某些内容，然后删除了内容并显示了味精。 如果可能的话，我想保留以下代码的格式，但只显示一次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

Answer 1

尝试这个：

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

Answer 2

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

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

Answer 3

我建议另一种方式。

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

因此，与其将每次循环中的内容清除为单个单元格并重复数百次， ClrRng使用ClrRng作为Range对象。 每次的时间If条件满足，你将它添加到ClrRng使用Application.Union功能。

完成循环遍历所有单元格后，请同时清除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