是否可以延迟 Worksheet_Change 代码？ Excel Vba答案

【问题标题】：Is it possible to delay the Worksheet_Change code? Excel Vba是否可以延迟 Worksheet_Change 代码？ Excel Vba
【发布时间】：2014-09-03 04:38:02
【问题描述】：

我正在填写一些数据验证下拉列表，它们的值在表格中。
我有一个按钮（链接到用户窗体）供用户将项目添加到表中。输入新值后，工作表的 Worksheet_Change 代码会对表格进行排序。
因此，如果删除了一个值，则表会调整大小。

但是现在我的问题是，当首先单击用户窗体中的按钮时，会将一行添加到表中，然后将值添加到该行中。在添加值之前，Worksheet_Change 已经检测到新的空行并将其删除。
是否有可能推迟这个，或者有人知道更好的解决方案吗？

用户表单的代码：

Private Sub butAddProject_Click()

    Dim listSheet As Worksheet
    Dim listTable As listObject
    Dim newRow As ListRow
    Dim ProjectName As String

    ProjectName = txtAddProject.Text

    Set listSheet = Sheets("Projects-Tasks")
    Set listTable = listSheet.ListObjects(1)

    If ProjectName <> "" Then
        Set newRow = listTable.ListRows.Add
        newRow.Range(1, 1).Value = ProjectName
    Else
        MsgBox "Enter a project name first!"
    End If

    txtAddProject.Text = ""
    formAddProject.Hide

End Sub

最后是 Worksheet_Change 的代码：

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim ws As Worksheet
    Dim strList As String
    Set ws = Sheets("Projects-Tasks")
    strList = Cells(2, Target.Column).listObject.Name

    If strList <> "" Then
        Application.ScreenUpdating = False
            With ListObjects(strList).Sort
                .SortFields.Add _
                    Key:=Cells(3, Target.Column), _
                    SortOn:=xlSortOnValues, _
                    Order:=xlAscending
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With

        With ws.ListObjects(strList)
            .Resize .DataBodyRange.CurrentRegion
        End With

    End If

    Application.ScreenUpdating = True

End Sub

提前致谢！

【问题讨论】：

你能查到Target.Value = ""吗？
对不起，你是什么意思？
我的意思是，如果更改的单元格（即Target）为空，您能否简单地绕过其余逻辑？
如果我这样做了，错误会延迟 1 或 2 秒，但它不能解决问题，谢谢 ;)

标签： vba excel excel-2013

【解决方案1】：

在添加新行时关闭事件：

If ProjectName <> "" Then
    application.enableevents = False
    Set newRow = listTable.ListRows.Add
    application.enableevents = True
    newRow.Range(1, 1).Value = ProjectName
Else

我假设您仍然希望在添加新值时对其进行排序，因此我在添加新值的行之前重置事件。

【讨论】：

值得注意的是，您可能需要添加一个错误处理程序以确保事件总是被重新打开。

【解决方案2】：

Private Sub butAddProject_Click()

    Dim listSheet As Worksheet
    Dim listTable As listObject
    Dim newRow As ListRow
    Dim ProjectName As String

    Application.EnableEvents=False 

    ProjectName = txtAddProject.Text

    Set listSheet = Sheets("Projects-Tasks")
    Set listTable = listSheet.ListObjects(1)

    If ProjectName <> "" Then
        Set newRow = listTable.ListRows.Add
        newRow.Range(1, 1).Value = ProjectName
    Else
        MsgBox "Enter a project name first!"
    End If

    txtAddProject.Text = ""
    formAddProject.Hide

    Application.EnableEvents=True


End Sub

【讨论】：