VBA突出显示选定的行将导致select整个行

我编写了一个突出显示所选行的代码。 如果select更改 – 新select的行将突出显示，并且之前select的格式将返回到最初的一个。 我用

• 第9行作为高亮格式化示例和
• 第10行作为未选定行的条件格式化的基准。

代码工作正常。 但是，当选中单元格时，该行将突出显示，所选单元格保持活动状态，但整行被选中。 有人可以帮我取消除目标单元格以外的所有内容吗？

没有从这里帮助。

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