Question

是否可以使此代码的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

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作为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

Vba msgbox只显示一次

3 个答案: