借助细线十字线，可以在同一行中的excel中轻松导航 [英] Easy navigation in excel within the same row with the aid of a hairline cross

问题描述

我有一个包含20张纸的Excel文件（xls），并且希望借助半透明的灰色发际线轻松在同一行上导航。我是VBA的新手，但是我花了几个小时来寻找解决方案，很不幸，目前还没有成功。

I have a Excel file (xls) with 20 sheets and like to navigate easily on the same row with the aid of a semi-transparent grey hairline cross. I'm a newbie in VBA and I've spend several hours searching a solution, unfortunately without success at now.

在B3中，假设数字7在B4中，数字10：

Let's say in B3 there is the number 7 written, in B4 the number 10:

a）如果我单击任意单元格，例如B3，我想在B列和第3行上插入一条发际线

a) if I click on an arbitrary cell, e.g. B3, I'd like to have a hairline cross over column B and row 3

b）如果我用鼠标标记了字段B3和B4，则发际线会交叉（最初位于B3）应该消失，接下来当我将鼠标光标移到单元格B4的右下角并将加号拖动到下一个单元格B5中时，Excel自动将数字13粘贴（数字3的差10）在单元格B5中。 公式拖放功能也应与公式一起使用。
（不幸的是，对于大多数Excel文件/加载项，我都尝试过，这是不可能的。）。

b) if I mark with the mouse the fields B3 and B4, the hairline cross (initially at B3) should disappear, next when I go with the mouse coursor to the bottom right of the cell B4 and drag the "plus"-sign into the next cell B5 Excel automatically should paste the number 13 (difference of 3 added to number 10) in cell B5. The "formula-drag-and-drop" function should also work with formulas. (With most Excel files /Add-Ins I've tried unfortunately this wasn't possible).

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

Does someone knows an easy and workable solution for aims a) and b)?

编辑：其他excel功能（例如撤消和重做）的可用性应保持不变。

Usability of other excel functions (e.g. undo and redo) should remain.

推荐答案

我组装了一个VBA，该VBA应该符合您的要求。
刚过ThisWorkbook中的代码，它将激活所有工作表中的发际线交叉。
仅供参考，在当前行/列上使用条件格式创建发际十字，并在选择更改时进行更新。

I've assembled a piece of VBA that should match your requirements. Just past the code in ThisWorkbook, it will activate the hairline cross in all the sheets. FYI, the hairline cross is created with a conditional format on the current row/column and updated when the selection changes.

要在ThisWorkbook中放置的代码：

Code to place in 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

另一种不易出现问题的解决方案是删除每个节更改的格式条件。

Another solution less prone to issues would be to delete the format conditions for each section change. However it might be less performant.

EDIT2：添加了另一个支持快捷键（Ctrl + Shif + 8）的版本：

EDIT2 : Added another version with support for a shortcut (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

这篇关于借助细线十字线，可以在同一行中的excel中轻松导航的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！