Excel中的动态冻结窗格/冻结行

我需要Excel中的动态冻结标题行，因为我正在处理的工作表有多个表，这些表很大，如果它们位于同一工作表上，则更容易理解

但在无休止地搜索之后，我找不到解决方案，因为没有滚动事件，滚动也不会改变活动单元格

---

谢天谢地，我找到了一个解决办法。

在搜索如何识别活动窗口中运行的第一个可见行之后，我找到了一个可接受的解决方案

然后，我能够将代码转换成一个函数，该函数可以与计时器事件结合使用，计时器事件仅在需要冻结行的工作表上激活

工作表代码：

Private Sub Worksheet_Activate()
    StartFreezePaneTimeRefresh
End Sub

Private Sub Worksheet_Deactivate()
    StopFreezePaneTimeRefresh
End Sub

Private RefreshTime

Sub SetFreezePane()
    'Check if correct worksheet is active
    If ActiveWorkbook.ActiveSheet.Name = "Data" Then
        If IdentifyTopVisibleRow < 227 Then
            'Check if Frozen Row is the same as the Range to be Copied
            If Range("A1") <> Range("AN1") Then
                'Copy New Headers for Frozen Row
                Range("AN1:BU1").Copy
                Range("A1").PasteSpecial xlPasteValues
            End If
        ElseIf IdentifyTopVisibleRow > 227 Then
            'Check if Frozen Row is the same as the Range to be Copied
            If Range("A1") <> Range("AN2") Then
                'Copy New Headers for Frozen Row
                Range("AN2:BU2").Copy
                Range("A1").PasteSpecial xlPasteValues
            End If
        End If
    Else
        StopFreezePaneTimeRefresh
    End If
End Sub

Sub StartFreezePaneTimeRefresh()
    Call SetFreezePane
    RefreshTime = Now + TimeValue("00:00:01")
    Application.OnTime RefreshTime, "StartFreezePaneTimeRefresh"
End Sub

Sub StopFreezePaneTimeRefresh()
    On Error Resume Next
    Application.OnTime RefreshTime, "StartFreezePaneTimeRefresh", , False
End Sub

Public Function IdentifyTopVisibleRow() As Long
    'This code was found on MSDN at
    'https://social.msdn.microsoft.com/Forums/en-US/a6cff632-e123-4190-8556-d9f48af8fe9a/identify-first-visible-row-of-scrolled-excel-worksheet?forum=isvvba
    Dim lngTopRow As Long ' top row
    Dim lngNumRows As Long ' number of visible rows
    Dim lngLeftCol As Long ' leftmost column
    Dim lngNumCols As Long ' number of visible columns
    With ActiveWindow.VisibleRange
        lngTopRow = .Row
        lngNumRows = .Rows.Count
        lngLeftCol = .Column
        lngNumCols = .Columns.Count
    End With
    IdentifyTopVisibleRow = lngTopRow
End Function

动态冻结窗格模块代码：

Private Sub Worksheet_Activate()
    StartFreezePaneTimeRefresh
End Sub

Private Sub Worksheet_Deactivate()
    StopFreezePaneTimeRefresh
End Sub

Private RefreshTime

Sub SetFreezePane()
    'Check if correct worksheet is active
    If ActiveWorkbook.ActiveSheet.Name = "Data" Then
        If IdentifyTopVisibleRow < 227 Then
            'Check if Frozen Row is the same as the Range to be Copied
            If Range("A1") <> Range("AN1") Then
                'Copy New Headers for Frozen Row
                Range("AN1:BU1").Copy
                Range("A1").PasteSpecial xlPasteValues
            End If
        ElseIf IdentifyTopVisibleRow > 227 Then
            'Check if Frozen Row is the same as the Range to be Copied
            If Range("A1") <> Range("AN2") Then
                'Copy New Headers for Frozen Row
                Range("AN2:BU2").Copy
                Range("A1").PasteSpecial xlPasteValues
            End If
        End If
    Else
        StopFreezePaneTimeRefresh
    End If
End Sub

Sub StartFreezePaneTimeRefresh()
    Call SetFreezePane
    RefreshTime = Now + TimeValue("00:00:01")
    Application.OnTime RefreshTime, "StartFreezePaneTimeRefresh"
End Sub

Sub StopFreezePaneTimeRefresh()
    On Error Resume Next
    Application.OnTime RefreshTime, "StartFreezePaneTimeRefresh", , False
End Sub

Public Function IdentifyTopVisibleRow() As Long
    'This code was found on MSDN at
    'https://social.msdn.microsoft.com/Forums/en-US/a6cff632-e123-4190-8556-d9f48af8fe9a/identify-first-visible-row-of-scrolled-excel-worksheet?forum=isvvba
    Dim lngTopRow As Long ' top row
    Dim lngNumRows As Long ' number of visible rows
    Dim lngLeftCol As Long ' leftmost column
    Dim lngNumCols As Long ' number of visible columns
    With ActiveWindow.VisibleRange
        lngTopRow = .Row
        lngNumRows = .Rows.Count
        lngLeftCol = .Column
        lngNumCols = .Columns.Count
    End With
    IdentifyTopVisibleRow = lngTopRow
End Function

私人刷新时间
子窗格（）
'检查是否激活了正确的工作表
如果ActiveWorkbook.ActiveSheet.Name=“数据”，则
如果IdentificationToVisibleRow<227，则
'检查冻结行是否与要复制的范围相同
如果范围（“A1”）范围（“AN1”），则
'复制冻结行的新标题
范围（“AN1:BU1”）。副本
范围（“A1”）。粘贴特殊XLPaste值
如果结束
否则，如果IdentificationTopVisibleRow>227，则
'检查冻结行是否与要复制的范围相同
如果范围（“A1”）范围（“AN2”），则
'复制冻结行的新标题
范围（“AN2:BU2”）。副本
范围（“A1”）。粘贴特殊XLPaste值
如果结束
如果结束
其他的
停止冷冻Panetimerefresh
如果结束
端接头
子星freezepanetimerefresh（）
调用设置冻结窗格
刷新时间=现在+时间值（“00:00:01”）
Application.OnTime刷新时间，“StartFreezePaneTimeRefresh”
端接头
子站点冻结Panetimerefresh（）
出错时继续下一步
Application.OnTime RefreshTime，“StartFreezePaneTimeRefresh”，False
端接头
公共函数IdentifyTopVisibleRow（）的长度为
'此代码在MSDN上的
'https://social.msdn.microsoft.com/Forums/en-US/a6cff632-e123-4190-8556-d9f48af8fe9a/identify-first-visible-row-of-scrolled-excel-worksheet?forum=isvvba
变暗lngTopRow为长“顶行
将lngNumRows设置为“长”可见行数
Dim lngLeftCol作为最左侧的长列
Dim lngNumCols作为“长”可见列数
使用ActiveWindow.VisibleRange
lngTopRow=.Row
lngNumRows=.Rows.Count
lngLeftCol=.Column
lngNumCols=.Columns.Count
以
IdentificationTopVisibleRow=lngTopRow
端函数

该代码首先检查正确的工作表是否处于活动状态，如果处于活动状态，则每秒检查最上面的一行

如果顶行大于或小于每个表的起始行，它将检查第一个标题是否已设置，以防止其反复更改值

如果没有，它将根据用户在工作簿中的位置更改冻结的行值

注意事项：

更改延迟了1秒，但这对于我这样做是可以接受的

我在上面使用的工作表是“仅视图”，因为如果您知道如何设置第一行的值而不更改选择，这将不断地将焦点转移到第一行，这将非常有效