通过发际线的帮助，在同一行内的Excel中轻松导航

我有一个Excel文件（xls）与20张，并喜欢轻松地在同一行借助半透明的灰色发际线十字。 我是VBA的新手，我花了几个小时寻找一个解决scheme，不幸的是现在没有成功。

比方说B3中有7个数字，B4中的数字是10：

a）如果我点击一个任意的单元格，例如B3，我希望有一个发际线跨过B列和第3行

b）如果我用鼠标标记字段B3和B4，发线十字（最初在B3处）应该消失，然后当我用鼠标走到单元格B4的右下方，并将“加号”标记拖入下一个单元格B5 Excel将自动在单元格B5中粘贴数字13（添加到数字10的3的差异）。 “公式 – 拖放”function也应该适用于公式。 （与大多数Excel文件/加载项我已经尝试不幸这是不可能的）。

有人知道一个简单和可行的解决scheme的目标a）和b）？

编辑：其他Excel函数的可用性（如撤消和重做）应该保留。

Answer 1

我已经组装了一块符合你要求的VBA。 只要过了ThisWorkbook中的代码，它将激活所有工作表中的发际线。 仅供参考，使用当前行/列的条件格式创build细线十字，并在select更改时进行更新。

放在ThisWorkbook中的代码：

Private Const CROSS_BACKGROUND_COLOR = &HE0E0EA Private Const CROSS_BORDER_COLOR = &HE0E0E0 Private Const CROSS_PATTERN = xlPatternGray50 Private Const CELL_BACKGROUND_COLOR = &HFFFFFF Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal target As Range) Dim cdt As FormatCondition, cdtCross As FormatCondition, cdtCell As FormatCondition ' get the conditional formats for the sheet For Each cdt In Cells.FormatConditions If cdt.type = xlExpression Then If cdt.Formula1 = "=-1" Then Set cdtCell = cdt ElseIf cdt.Formula1 = "=-2" Then Set cdtCross = cdt End If End If Next ' diplay the cross if one cell is selected and if a copy/paste is not occuring If target.Columns.count = 1 And target.Rows.count = 1 And Application.CutCopyMode = 0 Then If cdtCell Is Nothing Then ' create the cross with a format condition on the row and column With target.FormatConditions.Add(xlExpression, Formula1:="=-1") .Interior.Color = CELL_BACKGROUND_COLOR End With With Union(target.EntireRow, target.EntireColumn) _ .FormatConditions.Add(xlExpression, Formula1:="=-2") .Interior.PatternColor = CROSS_BACKGROUND_COLOR .Interior.pattern = CROSS_PATTERN .Borders.Color = CROSS_BORDER_COLOR End With Else ' update the position of the cross cdtCell.ModifyAppliesToRange target cdtCross.ModifyAppliesToRange Union(target.EntireRow, target.EntireColumn) End If ElseIf Not cdtCell Is Nothing Then ' hide the cross at the bottom if the selection has more than one cell If cdtCross.AppliesTo.Column - cdtCell.AppliesTo.Column <> 1 Then cdtCell.ModifyAppliesToRange Cells(sh.Rows.count, 1) cdtCross.ModifyAppliesToRange Cells(sh.Rows.count, 2) End If End If End Sub 

解决问题的另一个解决scheme是删除每个部分更改的格式条件。 但是，性能可能不高。

编辑2：添加了另一个版本，支持快捷键（Ctrl + Shif + 8）：

 '' ' Code to place in ThisWorkbook '' Private Sub Workbook_Open() Application.OnKey "^+8", "ToggleCrossVisibility" End Sub Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal target As Range) DeleteCross sh If target.Columns.count = 1 And target.Rows.count = 1 Then CreateCross target End Sub '' ' Code to place in a new Module '' Private Const CROSS_BACKGROUND_COLOR = &HD0D0DA Private Const CROSS_BORDER_COLOR = &HE0E0E0 Private Const CROSS_PATTERN = xlPatternGray50 Private Const CELL_BACKGROUND_COLOR = &HFFFFFF Private CrossDisabled As Boolean Private Sub ToggleCrossVisibility() CrossDisabled = CrossDisabled Xor True DeleteCross ActiveSheet If Not CrossDisabled Then CreateCross ActiveCell End Sub Public Sub DeleteCross(ByVal target As Worksheet) ' delete the cross by deleting the conditions Static conditions(0 To 10) As FormatCondition Dim condition As FormatCondition, i& For Each condition In target.Cells.FormatConditions If condition.type = xlExpression Then If condition.Formula1 = "=-1" Then Set conditions(i) = condition i = i + 1 End If End If Next For i = 0 To i - 1 conditions(i).Delete Next End Sub Public Sub CreateCross(ByVal target As Range) If CrossDisabled Then Exit Sub ' create the cross with a format condition on the row and column With target.FormatConditions.Add(xlExpression, Formula1:="=-1") .Interior.color = CELL_BACKGROUND_COLOR End With With Union(target.EntireRow, target.EntireColumn) _ .FormatConditions.Add(xlExpression, Formula1:="=-1") .Interior.PatternColor = CROSS_BACKGROUND_COLOR .Interior.pattern = CROSS_PATTERN .Borders.color = CROSS_BORDER_COLOR End With End Sub 

Answer 2

我将回答（a）部分的（b）部分，因为我对（a）部分的解决scheme不是侵入任何单元格的内容，它不会影响您的拖放，复制和粘贴等。

1.创build一个空白工作表并将其命名为“CTRL”

2.打开VBA编辑器（Alt + F11）并将此代码粘贴到ThisWorkbook模块

 Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Sh.Name <> "CTRL" Then ThisWorkbook.Worksheets("CTRL").Range("A1") = Target(1).Address End If End Sub 

3.创build两个名称公式

单击名称pipe理器button，然后单击新build。

名字公式如下：

第二个名字公式如下：

4.使用公式创build条件格式以确定要格式化的单元格

这不幸的是，你需要为每一张纸创build。

格式规则如下：

这是公式：

 =OR(COLUMN(INDIRECT(ThisCellAddress))=COLUMN(INDIRECT(CrossAddress)),ROW(INDIRECT(ThisCellAddress))=ROW(INDIRECT(CrossAddress))) 

单元格格式可以select10％灰色填充和白色边框。

并将规则应用于整个工作表，即适用于=$1:$1048576 。

结果 ：

Answer 3

假设你想要所有20张床单的十字线高光（CHH），并且每张床单都保留十字线，则需要在每个工作表对象和一个正常模块中放置代码。

CHH将应用于除本身之外的选定单元格的列和行。 当select超过1个单元格时，CHH将被删除。

每个functionCHH的工作表对象的代码 ：

 Option Explicit Private oPrevRange As Range Private Sub Worksheet_SelectionChange(ByVal Target As Range) RangeSelectionChange Target, oPrevRange End Sub 

创build一个新的模块，说“ CrossHair ”并放置在代码下面（ 修改为在单元格上添加边框 ）：

 Option Explicit Private Const lColorCross As Long = 14277081 ' White with 15% darker: RGB(217,217,217) Sub RangeSelectionChange(ByRef Target As Range, ByRef oPrevRange As Range) On Error Resume Next With Target If .Count = 1 Then If Not oPrevRange Is Nothing Then ' Undo highlight on previous range If .Row <> oPrevRange.Row Then UndoCrossHairRow oPrevRange If .Column <> oPrevRange.Column Then UndoCrossHairCol oPrevRange End If Set oPrevRange = Target MakeCrossHair Target Else UndoCrossHair oPrevRange End If End With End Sub Private Sub MakeCrossHair(ByRef oRng As Range) With oRng With .EntireRow .Interior.Color = lColorCross With .Borders(xlInsideVertical) .LineStyle = xlContinuous .ThemeColor = 1 .TintAndShade = 0 .Weight = xlThin End With End With With .EntireColumn .Interior.Color = lColorCross With .Borders(xlInsideHorizontal) .LineStyle = xlContinuous .ThemeColor = 1 .TintAndShade = 0 .Weight = xlThin End With End With .Interior.Pattern = xlNone End With End Sub Private Sub UndoCrossHair(ByRef oRng As Range) UndoCrossHairRow oRng UndoCrossHairCol oRng End Sub Private Sub UndoCrossHairRow(ByRef oRng As Range) oRng.EntireRow.Interior.Pattern = xlNone oRng.EntireRow.Borders(xlInsideVertical).LineStyle = xlNone End Sub Private Sub UndoCrossHairCol(ByRef oRng As Range) oRng.EntireColumn.Interior.Pattern = xlNone oRng.EntireColumn.Borders(xlInsideHorizontal).LineStyle = xlNone End Sub 

这些交互不会影响正常的Excelfunction，因此（b）的第二部分不是问题。

唯一的问题是，如果你的数据已经很好地格式化，这个CHH毁了它。

示例截图：
注意一些范围（非表范围）有黄色填充的背景，被CHH删除。 恢复它们将是非常困难的。

Answer 4

把这个放在ThisWorkbook模块中

 Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) With Target If .Count = 1 Then Sh.Cells.Interior.ColorIndex = xlNone With ActiveCell .EntireRow.Interior.Color = RGB(217, 217, 217) .EntireColumn.Interior.Color = RGB(217, 217, 217) End With Else Sh.Cells.Interior.ColorIndex = xlNone If .Count = 3 And .Columns.Count = 1 Then .Cells(3, 1) = 10 + (.Cells(2, 1) - .Cells(1, 1)) End If End With End Sub 

Answer 5

你会考虑使用像rowliner一些加载项 ？