我希望用户能够在每一行上突出显示一个单元格
此代码突出显示了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
答案 0 :(得分：2)
不是将选定的单元格引用存储在单独的或隐藏的工作表上，而是可以将突出显示的单元格引用存储在内存中。它们只需要在加载工作表时进行初始化（通过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
答案 1 :(得分：1)
我相信您想将细胞颜色重置为正常细胞，而不是专门用白色背景填充它。
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。
如果在非红色时需要填充纯白色单元格，则可以使用此方法打开和关闭它。
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
答案 2 :(得分：0)
建议您使用Worksheet_BeforeDoubleClick方法跟踪突出显示的＆＃39;通过在隐藏的工作表上放置双击单元格的引用，然后在事件处理程序中使用条件格式或显式检查来突出显示相关单元格（或者＃34;单元格＆＃34;如果您允许单个单元格基于隐藏工作表上的值，选择多行上的单元格。如果您选择使用条件格式，则只要双击新单元格，就会在隐藏的工作表上更新引用，并自动重新计算条件格式。只有给定行上的一个单元格才会被突出显示＆＃39;。
或者，您可以通过调整双击事件处理代码来明确地执行此操作：
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
答案 3 :(得分：0)
试试这个：
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