Excel不断崩溃Worksheet_selectionChange

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 

第二式串数据一起和placeses该信息在是空的（又名第一隐藏小区）按钮被点击时的下一个小区。

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：这是我的其他公式的列表。也许这些东西与前面提到的代码相互作用？ A49：

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仅改变处理进一步孤立。

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，但值得一提的是其他人。