☰

是否可以将选定的单元格保持在距离 Excel 屏幕底部较远的位置 - 例如在到达底部之前自动滚动

tag-icon • tag-icon microsoft-excel
是否可以将选定的单元格保持在距离 Excel 屏幕底部较远的位置 - 例如在到达底部之前自动滚动

这个很难解释。想象一下你在 Excel 中，按下向下键在行间向下移动。到达屏幕底部后，再次按下向下键将使电子表格一次向下滚动一行，这样你选择的单元格就永远不会超出可见范围。

奇怪的是，我希望这种行为发生在我（比如说）距离底部 20 行时。因此，我选择的单元格下方始终有 20 个可见行。

我不是第一个想要这种行为的人 - 有谁知道这是否可能，如果可能的话，如何做？ 任何事物（几乎）在 VBA 中是可能的，但如果可能的话，我更喜欢非脚本解决方案 - 谢谢！

答案1

对于涉足 z/OS 的人来说，这是很容易理解的...

在 vba 之外，我知道滚动锁定可以防止选择在移动时发生变化，而向上/向下翻页可以保持相同的可视光标位置，但也会移动屏幕上显示的行数；但两者都不符合要求。

我设计了一个特殊情况 - 它使选择永久居中，至少在单元格大小固定时（否则计算会很混乱，如指出的那样，并且可能会更慢）。显示范围（即屏幕尺寸 + 缩放）可以动态确定，而额外成本很少。还没有处理范围选择 - 将根据左上角单元格居中，而不是居中或忽略，也不会将事件动态添加到新工作表中。

'Const SCRROWS = 24 ' Example screen size.
'Const SCRCOLS = 21
Global Pscrr As Long
Global Pscrc As Long

Function GetScreen() As Long()
Dim vret(2) As Long
If ActiveWindow.VisibleRange.Rows.Row + _
    ActiveWindow.VisibleRange.Rows.Count >= Rows.Count _
or ActiveWindow.VisibleRange.Columns.Column + _
    ActiveWindow.VisibleRange.Columns.Count >= Columns.Count Then
    vret(0) = Pscrr
    vret(1) = Pscrc
Else
    vret(0) = ActiveWindow.VisibleRange.Rows.Count
    vret(1) = ActiveWindow.VisibleRange.Columns.Count
    Pscrr = vret(0)
    Pscrc = vret(1)
End If
GetScreen = vret
End Function

Sub CenterScroll(slrow As Long, slcol As Long)
Dim nscrr As Long
Dim nscrc As Long
Dim scrsize() As Long
scrsize = GetScreen
nscrr = slrow - Int(scrsize(0) / 2)
If nscrr < 1 Then
    nscrr = 1
End If
nscrc = slcol - Int(scrsize(1) / 2)
If nscrc < 1 Then
    nscrc = 1
End If
ActiveWindow.ScrollRow = nscrr
ActiveWindow.ScrollColumn = nscrc
End Sub

Sub Button2_Click()
CenterScroll ActiveCell.Row, ActiveCell.Column
End Sub

'------Put this on the sheet which uses the scroll method------'
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
CenterScroll Target.Row, Target.Column
End Sub

添加 20% - 80% 的边缘限制应该相对简单（需要引入“动量”概念，然后检查选定的行 - 可见顶行是否 > 0.8 * 屏幕行等）；然而，强大的解决方案超出了我的范围。

答案2

右键单击工作表名称并选择查看代码，粘贴此代码。应该就可以了

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Selection.CountLarge > 1 Then Exit Sub
    Dim w As Window:    Set w = ActiveWindow
    Dim r As Range:     Set r = w.VisibleRange
    If Target.Row = r(1, 1).Row Then w.SmallScroll up:=1
    If Target.Row = r(1, 1).Offset(r.Rows.Count).Row - 20 Then w.SmallScroll down:=1
End Sub

相关内容