选择所有列导致Excel挂起，而事件SelectionChange(Intersect)中有代码

Question

我使用以下代码执行以下操作：

如果我选择A,D or E on any row (rows)的任何单元格，则随后选择同一行上的单元格B:G。它有效，但问题如果我选择(A、D或E(的任何整列，则excel hangs不响应
一如既往，我们将不胜感激。

Private Sub worksheet_SelectionChange(ByVal Target As Excel.Range)
Const cFirstRow As String = "A3,D3,E3"
Const sCols As String = "B:G"
Dim crg As Range
With Range(cFirstRow)
Set crg = Intersect(.Areas(1).EntireRow.Resize(Rows.Count - .Row + 1), .EntireColumn)
End With
Dim irg As Range: Set irg = Intersect(crg, Target)
If Not irg Is Nothing Then
Dim srg As Range, arg As Range, rrg As Range
For Each arg In irg.Areas
For Each rrg In arg.Rows
If srg Is Nothing Then
Set srg = Columns(sCols).Rows(rrg.Row)
Else
Set srg = Union(srg, Columns(sCols).Rows(rrg.Row))
End If
Next rrg
Next arg
If Not srg Is Nothing Then
srg.Select
End If
End If

End Sub

Answer 1

如果您只需要选择"B： G〃；在同一行中，每当用户在"；A、 D或E"；那么就不需要那么多行代码了：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim TrimmedRange As Range
Set TrimmedRange = Intersect(Target, Me.Range("A:A,D:D,E:E"))
If TrimmedRange Is Nothing Then Exit Sub
Application.EnableEvents = False
Union(Target, Intersect(TrimmedRange.EntireRow, Me.Range("B:G"))).Select
Application.EnableEvents = True
End Sub

如果要排除行1&2从这个交互中，你可以添加几行：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim TrimmedRange As Range
Set TrimmedRange = Intersect(Target, Me.Range("3:" & Me.Rows.Count))
If TrimmedRange Is Nothing Then Exit Sub
Set TrimmedRange = Intersect(TrimmedRange, Me.Range("A:A,D:D,E:E"))
If TrimmedRange Is Nothing Then Exit Sub
Application.EnableEvents = False
Union(Target, Intersect(TrimmedRange.EntireRow, Me.Range("B:G"))).Select
Application.EnableEvents = True
End Sub

以上代码的解释：

• Me.Range("3:" & Me.Rows.Count)：创建从第3行到工作表末尾的所有内容的范围
• Intersect(Target, ...：将Target与范围进行比较，返回两个范围内的所有单元格。这是通过删除排除的行1或2中的任何内容来有效地修剪用户的选定范围
• Set TrimmedRange = ...：将修剪后的范围保存到变量中
• Intersect(TrimmedRange, Me.Range("A:A,D:D,E:E"))：删除不在A、D、E列中的所有单元格
• Set TrimmedRange = ...：将该双修剪范围保存到变量
• TrimmedRange.EntireRow：将剩余单元格扩展为整行
• CCD_ 10：将那些行与列"相比较"；B： G〃；并找到任何重叠的单元格。将A、D、E单元抽象地扩展成整行，然后取"0"；B： G〃；部分
• Union(Target, ...：将原始用户选择的范围重新添加到整个事件中
• Select：选择完成的范围

Answer 2

请以下一种方式尝试您的改编代码，它几乎是即时的，但我认为使用它是不明智的…

Private Sub worksheet_SelectionChange(ByVal Target As Excel.Range)
Const cFirstRow As String = "A3,D3,E3"
Const sCols As String = "B3:G3"
Dim crg As Range, rngBG As Range
With Range(cFirstRow)
Set crg = Intersect(.Areas(1).EntireRow.Resize(rows.Count - .row + 1), .EntireColumn)
Set rngBG = Intersect(Range(sCols).Areas(1).EntireRow.Resize(rows.Count - Range(sCols).row + 1), Range(sCols).EntireColumn)
End With
Dim irg As Range: Set irg = Intersect(crg, Target)

If Not irg Is Nothing Then
Dim srg As Range
Set srg = Intersect(rngBG, irg.EntireRow)
If Not srg Is Nothing Then
Application.EnableEvents = False 'without this part, the event will run twice
srg.Select
Application.EnableEvents = True
End If
End If

End Sub

Answer 3

选择选择的行范围

• 这符合发布代码的精神。结果可能与FaneDuru的解决方案相同，后者的处理方式有所不同

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Const cFirstRow As String = "A3,D3,E3"
Const sCols As String = "B:G"
Dim crg As Range
With Range(cFirstRow)
Set crg = Intersect(.Areas(1).EntireRow _
.Resize(Rows.Count - .Row + 1), .EntireColumn)
End With
Dim irg As Range: Set irg = Intersect(crg, Target)
If Not irg Is Nothing Then
Dim srg As Range: Set srg = Intersect(irg.EntireRow, Columns(sCols))
Application.EnableEvents = False
srg.Select
Application.EnableEvents = True
End If

End Sub