Question

我正在运行两个VBA公式。

第一列将第一列中包含空信息的所有单元格隐藏起来。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

     Dim c As Range
     On Error Resume Next

     Application.ScreenUpdating = False

     For Each c In Range("A3:A49")
        If c.Value = vbNullString Then
            c.EntireRow.Hidden = True
        End If
    Next c

    For Each c In Range("A3:A47")
        If c.Value <> vbNullString Then
            c.EntireRow.Hidden = False
        End If
    Next c

    Application.ScreenUpdating = True

End Sub

第二个公式将数据串在一起，并在单击按钮时将此信息放在下一个空单元格（即第一个隐藏单元格）中。

Option Explicit

    Dim iwsh As Worksheet
    Dim owsh As Worksheet
    Dim output As String
    Dim i As Integer

    Sub Copy()

    Set iwsh = Worksheets("Budget")
    Set owsh = Worksheets("Release Burnup")

    i = 3

    While owsh.Cells(i, 1) <> ""

    i = i + 1

    Wend

    output = "R" & iwsh.Cells(13, 2).Value & "-S" & iwsh.Cells(14, 2).Value

    owsh.Cells(i, 1) = output

    ActiveSheet.EnableCalculation = False
    ActiveSheet.EnableCalculation = True

End Sub

以前，这已经没有造成任何问题了......当我尝试使用新数据删除其中一个单元格中的信息时，发生了导致工作簿崩溃的事情。

PS：这是我其他公式的列表。也许这些东西与上述代码相互作用？

Private Sub NewMemberBut_Click()

    'causes userform to appear
    NewMember.Show

    'reformats button because button kept changing size and font
    NewMemberBut.AutoSize = False
    NewMemberBut.AutoSize = True
    NewMemberBut.Height = 40.25
    NewMemberBut.Left = 303.75
    NewMemberBut.Width = 150

End Sub

'Similar code to the problematic code in question, but this one works fine
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim c As Range
    On Error Resume Next

    Application.ScreenUpdating = False

    For Each c In Range("A3:A35,A41:A80")
        If c.Value = vbNullString Then
            c.EntireRow.Hidden = True
        End If
    Next c

    For Each c In Range("A3:A35,A41:A80")
        If c.Value <> vbNullString Then
            c.EntireRow.Hidden = False
        End If
    Next c

    Application.ScreenUpdating = True

End Sub


'Code for UserForm

Option Explicit

    Dim mName As String
    Dim cName As String
    Dim mRole As String
    Dim cRole As String
    Dim i As Integer
    Dim x As Integer
    Dim Perc As Integer
    Dim Vac As Integer
    Dim Prj As Worksheet
    Dim Bud As Worksheet

Private Sub NewMember_Initialize()

    txtName.Value = ""

    cboRoleList.Clear

    Scrum.Value = False

    txtPercent.Value = ""

    txtVacation.Value = ""

    txtName.SetFocus

End Sub

Private Sub AddMember_Click()

    If Me.txtName.Value = "" Then
        MsgBox "Please enter a Member name.", vbExclamation, "New Member"
        Me.txtName.SetFocus
    Exit Sub
    End If

    If Me.cboRoleList = "Other" And Me.txtCustomRole = "" Then
        MsgBox "Please provide a role name.", vbExclamation, "Other Role"
    Exit Sub
    End If

    If Me.cboRoleList.Value = "" Then
        MsgBox "Please select a Role.", vbExclamation, "Member Role"
        Me.cboRoleList.SetFocus
    Exit Sub
    End If

    If Me.cboRoleList <> "Other" And Me.txtPercent = "" Then
        MsgBox "Please select a valid percentage to be applied to this sprint.", vbExclamation, "Sprint Percent"
        Me.txtPercent.SetFocus
    Exit Sub
    End If

    If Me.txtPercent.Value > 100 And Me.txtPercent <> "" Then
        MsgBox "Please select a valid percentage to be applied to this sprint.", vbExclamation, "Sprint Percent"
        Me.txtPercent.SetFocus
    Exit Sub
    End If

    If Me.txtVacation.Value = "" Then
        Me.txtVacation.Value = 0
    End If

    Dim i As Long

    Set Prj = Worksheets("Project Team")
    Set Bud = Worksheets("Budget")

    Prj.Activate

    i = 5
    x = 1
    If Me.cboRoleList.Value = "Other" Then
        i = 46
    End If


    While Prj.Cells(i, 1) <> ""
        i = i + 1
    Wend

    If cboRoleList = "Other" Then
        Cells(i, x).Value = txtCustomRole.Value
    End If

    If cboRoleList <> "Other" Then
        Cells(i, x).Value = cboRoleList.Value
    End If
    x = x + 1

    Cells(i, x).Value = txtName.Value
    x = x + 1

    If Me.cboRoleList.Value <> "Other" Then
        Cells(i, x).Value = txtPercent.Value
    End If

    Unload Me
End Sub


Private Sub CloseBut_Click()

    Unload Me

End Sub

Answer 1

将事件驱动的Worksheet_SelectionChange更改为Worksheet_Change并进一步隔离，只处理A3：A49中的某些内容发生变化时。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("A3:A49")) Is Nothing Then
        On Error GoTo safe_exit
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Dim c As Range
        For Each c In Intersect(Target, Range("A3:A49"))
            c.EntireRow.Hidden = CBool(c.Value = vbNullString)
        Next c
    End If

safe_exit:
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

警告：对于单元格公式中单元格的更改，不会触发Worksheet_Change。只能输入，删除或拖动单元格的内容。添加或删除公式将触发它，但不会在公式的结果从工作簿中某处更改的其他值更改时触发。这不应该影响你，因为没有公式可以返回vbNullString，但值得一提的是其他人。

Excel与Worksheet_selectionChange一起崩溃

1 个答案: