通过双击高亮显示MS Excel 2007中的单元格
我希望用户能够突出显示每一行上的一个单元格
这段代码突出了Excel 2007中的单元格，但是我的问题是，我不能编写代码来限制用户只突出显示一行中的一个单元格，
这里是代码：
Private Sub Worksheet_BeforeDoubleClick( _ ByVal Target As Range, Cancel As Boolean) ' This macro is activated when you doubleclick ' on a cell on a worksheet. ' Purpose: color or decolor the cell when clicked on again ' by default color number 3 is red If Target.Interior.ColorIndex = 3 Then ' if cell is already red, remove the color: Target.Interior.ColorIndex = 2 Else ' make the cell red: Target.Interior.ColorIndex = 3 End If ' true to cancel the 'editing' mode of a cell: Cancel = True End Sub 而不是将选定的单元格引用存储在单独的或隐藏的工作表上，突出显示的单元格引用可以存储在内存中。 他们只需要在加载表格时（通过Worksheet_Activate()方法）进行初始化，否则将以类似的方式工作。
将以下代码添加到工作簿中的相关工作表：
' Set of highlighted cells indexed by row number Dim highlightedCells As New Collection ' Scan existing sheet for any cells coloured 'red' and initialise the ' run-time collection of 'highlighted' cells. Private Sub Worksheet_Activate() Dim existingHighlights As Range ' Reset the collection of highlighted cells ready to rebuild it Set highlightedCells = New Collection ' Find the first cell that has its background coloured red Application.FindFormat.Interior.ColorIndex = 3 Set existingHighlights = ActiveSheet.Cells.Find("", _ LookIn:=xlValues, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False, _ SearchFormat:=True) ' Process for as long as we have more matches Do While Not existingHighlights Is Nothing cRow = existingHighlights.Row ' Add a reference only to the first coloured cell if multiple ' exist in a single row (will only occur if background manually set) Err.Clear On Error Resume Next Call highlightedCells.Add(existingHighlights.Address, CStr(cRow)) On Error GoTo 0 ' Search from the cell after the last match. Note an error in Excel ' appears to prevent the FindNext method from finding formats correctly Application.FindFormat.Interior.ColorIndex = 3 Set existingHighlights = ActiveSheet.Cells.Find("", _ After:=existingHighlights, _ LookIn:=xlValues, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False, _ SearchFormat:=True) ' Abort the search if we've looped back to the top of the sheet If (existingHighlights.Row < cRow) Then Exit Do End If Loop End Sub Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim hCell As String Dim cellAlreadyHighlighted As Boolean hCell = "" Err.Clear On Error Resume Next hCell = highlightedCells.Item(CStr(Target.Row)) On Error GoTo 0 If (hCell <> "") Then ActiveSheet.Range(hCell).Interior.ColorIndex = 0 If (hCell = Target.Address) Then Call highlightedCells.Remove(CStr(Target.Row)) Target.Interior.ColorIndex = 0 Else Call highlightedCells.Remove(CStr(Target.Row)) Call highlightedCells.Add(Target.Address, CStr(Target.Row)) Target.Interior.ColorIndex = 3 End If Else Err.Clear On Error Resume Next highlightedCells.Remove (CStr(Target.Row)) On Error GoTo 0 Call highlightedCells.Add(Target.Address, CStr(Target.Row)) Target.Interior.ColorIndex = 3 End If Cancel = True End Sub
我相信你想重置单元格颜色到一个正常的单元格，而不是专门用白色背景填充它。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Cancel = True Dim iCOLOR As Long If Target.Interior.ColorIndex <> 3 Then _ iCOLOR = 3 Rows(Target.Row).Interior.Pattern = xlNone If iCOLOR = 3 Then _ Target.Interior.ColorIndex = iCOLOR End Sub
去除填充的方法是设置.Interior.Pattern = xlNone 。
如果不是红色的时候需要填充白色的单元格，那么可以用这个开关来打开和closures。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Cancel = True Dim iCOLOR As Long iCOLOR = 3 + CBool(Target.Interior.ColorIndex = 3) Rows(Target.Row).Cells.Interior.ColorIndex = 2 Target.Interior.ColorIndex = iCOLOR End Sub
当然， ListObject提供了一组不同的问题。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, ListObjects("Table1").DataBodyRange) Is Nothing Then Cancel = True Dim iCOLOR As Long iCOLOR = 3 + CBool(Target.Interior.ColorIndex = 3) Intersect(Rows(Target.Row), ListObjects("Table1").DataBodyRange).Interior.ColorIndex = 2 Target.Interior.ColorIndex = iCOLOR End If End Sub
build议您使用Worksheet_BeforeDoubleClick方法通过将双击单元格的引用放置在隐藏工作表上来跟踪“突出显示”单元格，然后在事件处理程序中使用条件格式化或显式检查来突出显示相关单元格（或“单元格”if您可以根据隐藏工作表上的值select多行上的单个单元格。 如果select使用条件格式，则每当“双击”新单元格时，引用将在隐藏表格上更新，条件格式将自动重新计算。 一个给定的行中只有一个单元格将永远保持“突出显示”。
或者，你可以通过调整你的双击事件处理代码来明确地做到这一点：
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If (Not (IsEmpty(Worksheets("Sheet2").Cells(1, 1).Value))) Then ActiveSheet.Range(Worksheets("Sheet2").Cells(1, 1).Value).Interior.ColorIndex = 0 End If Worksheets("Sheet2").Cells(1, 1).Value = Target.Address ActiveSheet.Range(Worksheets("Sheet2").Cells(1, 1).Value).Interior.ColorIndex = 3 End Sub
通过这种方式，您也可以在加载工作表时检查任何突出显示的单元格，并在适当的情况下重置它们（假设允许用户保存更改）。
要突出显示任意给定行上的一个单元格（但允许多行显示单个突出显示的单元格），可以使用以下命令（也可以在已突出显示的单元格中切换突出显示）：
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If (Not (IsEmpty(Worksheets("Sheet2").Cells(Target.Row, 1).Value))) Then ActiveSheet.Range(Worksheets("Sheet2").Cells(Target.Row, 1).Value).Interior.ColorIndex = 0 If (Worksheets("Sheet2").Cells(Target.Row, 1).Value = Target.Address) Then Worksheets("Sheet2").Cells(Target.Row, 1).Value = "" Target.Interior.ColorIndex = 0 Else Worksheets("Sheet2").Cells(Target.Row, 1).Value = Target.Address Target.Interior.ColorIndex = 3 End If Else Worksheets("Sheet2").Cells(Target.Row, 1).Value = Target.Address Target.Interior.ColorIndex = 3 End If Cancel = True End Sub
试试这个：
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'Target must be between column "A" which is 1 & "G" which is 7 and also between row 1 and 10. 'I also add checking for row. If you don't need, remove it. If Target.Column >= 1 And Target.Column <= 7 And Target.row >= 1 And Target.row <= 10 Then If Target.Interior.ColorIndex = 3 Then ' if cell is already red, remove the color: Target.Interior.ColorIndex = 2 Else ' make the cell red: Target.Interior.ColorIndex = 3 End If ' true to cancel the 'editing' mode of a cell: Cancel = True End If End Sub