選擇所有列會導致Excel在事件SelectionChange（相交）中有代碼時掛起？

我正在使用以下代碼執行以下操作：

如果我選擇任何單元格，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

uj5u.com熱心網友回復：

請以下一種方式嘗試您改編的代碼，它幾乎可以立即執行相同的操作，但我認為使用它并不明智......

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

uj5u.com熱心網友回復：

如果您只需要在用戶選擇“A、D 或 E”中的內容時在同一行中選擇“B:G”，那么就不需要這么多行代碼：

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
    Union(Target, Intersect(TrimmedRange.EntireRow, Me.Range("B:G"))).Select
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
    Union(Target, Intersect(TrimmedRange.EntireRow, Me.Range("B:G"))).Select
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 ：將剩余的單元格擴展為整行。
• Intersect(TrimmedRange.EntireRow, Me.Range("B:G"))：將這些行與“B:G”列進行比較，并找到任何重疊的單元格。基本上將 A、D、E 單元格擴展為整行，然后采用其中的“B:G”部分。
• Union(Target, ... ：將原始用戶選擇的范圍重新添加到整個事物中
• Select ：選擇完成的范圍。

標籤：擅长 vba

上一篇：使用宏打開檔案

下一篇：帶有增量行和列的VBAExcel回圈