Excel不断与Worksheet_selectionChange崩溃

我正在运行两个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 

第二个公式将数据串在一起，并在单击该button时将该信息放置在空的下一个单元（又名第一个隐藏的单元）中。

 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。 只有通过input，删除或拖动单元格的内容。 添加或删除公式将触发它，但是公式的结果从工作簿中某处更改的另一个值更改时不会触发。 这不应该影响你，因为没有公式可以返回vbNullString，但值得一提的是别人。