Question

你可以帮帮我吗？如何根据我们放置所选单元格的位置自动着色单元格和列？例如，当我们选择单元格D4时，行D将被着色，直到第4列和第4列也将被着色，直到第D行

三江源，安德烈

Answer 1

<强>简介

-2和关闭（1）（正如我所写）将是因为问题听起来像是＃34;为我解决我的整个问题＆＃34;在这里不受欢迎。这个站点是程序员帮助其他程序员开发的，这样他们就可以解决自己的问题。

然而，我不确定你所寻求的是否可能，我感兴趣所以我编码了我认为是完整的解决方案。我想我已经想到了一切，除了一个例外，它似乎都按照我的意愿工作。例外是工作簿保存。如果在保存之前删除突出显示（以便在保存的工作簿中没有突出显示），则会询问用户是否要保存工作簿，即使他们已经请求保存，因为删除突出显示是一个更改。即使没有其他更改，也会始终询问是否要保存工作簿，因为突出显示。

此代码依赖于事件和事件例程。发生事件时，Excel会查找用户编码的事件例程。如果存在，Excel将执行该例程。这样的例程可以执行普通宏可以执行的任何操作。

此代码必须安装在您需要此功能的每个工作簿中。我不认为您可以将其安装在PERSONAL工作簿中，并将其提供给所有工作簿，但我还没有尝试过。

<强>安装

打开您需要此功能的工作簿，然后打开VB编辑器。

您需要一个包含以下内容的模块：

' Used by cell highlighting code
Public CellHighColLast As Long
Public CellHighRowLast As Long

这可以是任何模块，包括专门用于保存这些变量的模块

在Project Explorer中，您将拥有一行＆＃34; Microsoft Excel Objects＆＃34;。如果有＆＃34; +＆＃34;在＆＃34; Microsoft Excel Objects＆＃34;的左侧，单击它，它将变为＆＃34; - ＆＃34;。

＆＃34; Microsoft Excel Objects＆＃34;每个工作表都有一行，加在底部，＆＃34; ThisWorkbook＆＃34;。

如果单击顶部工作表的行，将显示为该工作表保留的空白代码区域。将下面的代码粘贴到该代码区域中：

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal TargetCrnt As Range)

  Dim ColCrnt As Long
  Dim RowCrnt As Long

  ColCrnt = TargetCrnt.Column
  RowCrnt = TargetCrnt.Row

  Debug.Print "User has moved cursor within worksheet " & _
              TargetCrnt.Worksheet.Name & " from " & _
              Replace(Cells(CellHighRowLast, CellHighColLast).Address, "$", "") & _
              " to " & _
              Replace(Cells(RowCrnt, ColCrnt).Address, "$", "")

  ' Remove highlighting from previous active cell
  With Range(Cells(CellHighRowLast, 1), Cells(CellHighRowLast, CellHighColLast))
    .Interior.ColorIndex = xlNone
  End With
  With Range(Cells(1, CellHighColLast), Cells(CellHighRowLast, CellHighColLast))
    .Interior.ColorIndex = xlNone
  End With

  ' Hightlight new cell
  With Range(Cells(RowCrnt, 1), Cells(RowCrnt, ColCrnt))
    .Interior.Color = RGB(255, 255, 153)        ' Pale yellow
  End With
  With Range(Cells(1, ColCrnt), Cells(RowCrnt, ColCrnt))
   .Interior.Color = RGB(255, 255, 153)        ' Pale yellow
  End With

  ' Record new active cell as last cell ready for next move
  CellHighColLast = ColCrnt
  CellHighRowLast = RowCrnt

End Sub

您需要点击每张工作表的行，然后将上面的代码粘贴到其代码区域中。

最后点击＆＃34; ThisWorkbook＆＃34;将以下代码行并粘贴到其代码区域中：

Option Explicit
Sub Workbook_Open()

  ' The workbook has just been opened:

  ' Record initial active cell as last cell ready for next move
  CellHighColLast = ActiveCell.Column
  CellHighRowLast = ActiveCell.Row

  Debug.Print "Workbook opened with active cell being " & ActiveSheet.Name & _
              "!" & Replace(ActiveCell.Address, "$", "")

  ' Highlight active cell
  With Range(Cells(CellHighRowLast, 1), Cells(CellHighRowLast, CellHighColLast))
   .Interior.Color = RGB(255, 255, 153)        ' Pale yellow
  End With
  With Range(Cells(1, CellHighColLast), Cells(CellHighRowLast, CellHighColLast))
   .Interior.Color = RGB(255, 255, 153)        ' Pale yellow
  End With

End Sub
'Private Sub Workbook_BeforeSave(ByVal SaveAsUi As Boolean, Cancel As Boolean)
'
'  Debug.Print "User is saving workbook"
'
'  ' Remove highlighting from active cell before saving
'  With Range(Cells(CellHighRowLast, 1), Cells(CellHighRowLast, CellHighColLast))
'    .Interior.ColorIndex = xlNone
'  End With
'  With Range(Cells(1, CellHighColLast), Cells(CellHighRowLast, CellHighColLast))
'    .Interior.ColorIndex = xlNone
'  End With
'
'End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)

  ' The user has selected a new worksheet or has created a new worksheet.

  Debug.Print "User has selected worksheet" & Sh.Name

  Dim ColCrnt As Long
  Dim RowCrnt As Long

  ColCrnt = ActiveCell.Column
  RowCrnt = ActiveCell.Row

  ' Hightlight active cell
  With Range(Cells(RowCrnt, 1), Cells(RowCrnt, ColCrnt))
   .Interior.Color = RGB(255, 255, 153)        ' Pale yellow
  End With
  With Range(Cells(1, ColCrnt), Cells(RowCrnt, ColCrnt))
   .Interior.Color = RGB(255, 255, 153)        ' Pale yellow
  End With

  ' Record new active cell as last cell ready for next move
  CellHighColLast = ColCrnt
  CellHighRowLast = RowCrnt

End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)

  ' The user has selected a new worksheet or has created a new worksheet.

  Debug.Print "User has left worksheet" & Sh.Name

  ' Remove highlighting from old worksheet
  With Sh
    With .Range(.Cells(CellHighRowLast, 1), _
                .Cells(CellHighRowLast, CellHighColLast))
      .Interior.ColorIndex = xlNone
    End With
    With .Range(.Cells(1, CellHighColLast), _
                .Cells(CellHighRowLast, CellHighColLast))
      .Interior.ColorIndex = xlNone
    End With
  End With

End Sub

保存工作簿并退出。如果出现任何宏错误，请单击结束;错误将是由于在打开工作簿时初始化功能而引起的。

如何运作

在＆＃34; ThisWorkbook＆＃34;代码区域有一个名为Workbook_Open()的事件例程。顾名思义，这是在打开工作簿并在用户获得控制权之前调用的。此例程保存光标的初始位置并突出显示活动单元格。我使用淡黄色但你可以改变你喜欢的任何颜色。注意我已经包含Debug.Print语句来记录立即窗口中的光标移动和工作表更改。我建议你在对这些宏进行初步测试后删除它们。

当用户在工作表中移动光标时，将执行工作表代码区域中的Worksheet_SelectionChange()事件例程。此例程从旧的活动单元格中删除突出显示，并将其应用于新的活动单元格。

当用户切换工作表时，＆＃34; ThisWorkbook＆＃34;中的Workbook_SheetDeactivate()和Workbook_SheetActivate事件例程执行。第一个从旧工作表中删除突出显示，而第二个将其添加到新工作表。

我已经包含了我编码的Workbook_BeforeSave()例程，但已对其进行了评论。此例程会在保存之前删除突出显示但会导致重复＆＃34;您要保存＆＃34;题。您可能希望取消注释此例程并进行实验。

为色谱柱和细胞着色

1 个答案: