VBA突出顯示所選行導致選擇整行

Question

我組成了突出顯示所選行的代碼。如果選擇更改 - 新選中的行將突出顯示，並且之前選擇的格式將返回到初始狀態。我用

• 列9作爲高亮格式樣品並作爲基線爲未選中的行的條件格式
• 排10。

該代碼工作正常。但是，選中單元格後，該行將突出顯示，所選單元格保持活動狀態，但選中整行。有人可以幫助我取消選擇除目標單元格外的所有內容嗎？

here沒有幫助。

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 

LastRowA = Range("A" & Rows.Count).End(xlUp).Row 

If Target.Cells.Count > 1 Or Target.Cells.Count < 1 Then 'If selected 1 cell 
    'Do nothing 
Else 
    Application.ScreenUpdating = False 
    If Target.Row > 10 And Target.Row < LastRowA + 1 Then 

     Rows("10:10").Copy 'Restore all rows to custom conditional formatting of row 10 
     For tableRow = 11 To LastRowA 
      Rows(tableRow & ":" & tableRow).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
     Next tableRow 

     Rows("9:9").Copy 'Highlight active row using formating of row #9 
     Rows(Target.Row).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 

     Application.CutCopyMode = False 
     Target.Cells.Activate 'Return Target to initially selected cell 
    End If 
    Application.ScreenUpdating = True 
End If 

End Sub 

Answer 1

試試這個

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
Dim LastRowA As Long 
Dim tableRow As Long 

LastRowA = Range("A" & Rows.Count).End(xlUp).Row 

If Target.Cells.Count > 1 Or Target.Cells.Count < 1 Then 'If selected 1 cell 
    'Do nothing 
Else 
    Application.ScreenUpdating = False 
    If Target.Row > 10 And Target.Row < LastRowA + 1 Then 

     Rows("10:10").Copy 'Restore all rows to custom conditional formatting of row 10 
     For tableRow = 11 To LastRowA 
      Rows(tableRow & ":" & tableRow).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
     Next tableRow 

     Rows("9:9").Copy 'Highlight active row using formating of row #9 
     Rows(Target.Row).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 

     Application.CutCopyMode = False 
     Target.Cells.Activate 'Return Target to initially selected cell 
     Application.EnableEvents = False 
     Target.Cells.Select 
     Application.EnableEvents = True 
    End If 
    Application.ScreenUpdating = True 
End If 

End Sub