Question

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

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

userform的代码：

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

提前感谢！

Answer 1

添加新行时关闭事件：

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

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

Answer 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

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

2 个答案: