☰

是否可以將選取的儲存格保持在距離 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

相關內容