Sub FreezeTopRow()
'First save the current selection to go back to it later
Dim rngOriginalSelection As Range
Set rngOriginalSelection = Selection
'Change selection to A2 to make .FreezePanes work
ActiveSheet.Range("A2").Select
ActiveWindow.FreezePanes = True
'Change selection back to original
rngOriginalSelection.Select
End Sub
Public Sub FreezeTopRowPane(ByRef MyWs As Excel.Worksheet, _
Optional ByVal AfterRowNr As Integer = 1)
Dim SavedWS As Worksheet
Dim SavedUpdating As Boolean
SavedUpdating = Application.ScreenUpdating 'save current screen updating mode
Set SavedWS = ActiveSheet 'save current active sheet
Application.ScreenUpdating = False 'turn off screen updating
MyWs.Activate 'activate worksheet for panes freezing
ActiveWindow.FreezePanes = False 'turn off freeze panes in case
With ActiveWindow
.SplitColumn = 0 'set no column to split
.SplitRow = AfterRowNr 'set the row to split, default = row 1
End With
ActiveWindow.FreezePanes = True 'trigger the new pane freezing
SavedWS.Activate 'restore previous (saved) ws as active
Application.ScreenUpdating = SavedUpdating 'restore previous (saved) updating mode
End Sub
Dim numLoops As Long
Dim StartTime, LoopTime As Long
numLoops = 1000
Debug.Print ("Timing test of numloops:" & numLoops)
StartTime = Timer
For I = 0 To numLoops
targetSheet.Activate
With ActiveWindow
If .FreezePanes Then .FreezePanes = False
.SplitColumn = 2
.SplitRow = 1
.FreezePanes = True
End With
Next I
LoopTime = Timer
Debug.Print ("Total time of activate method:" & Format((LoopTime - StartTime) / 86400, "hh:mm:ss"))
StartTime = Timer
For I = 0 To numLoops
targetSheet.Select
Application.Range("C2").Select
Application.ActiveWindow.FreezePanes = True
Next I
LoopTime = Timer
Debug.Print ("Total time of select method:" & Format((LoopTime - StartTime) / 86400, "hh:mm:ss"))
这是结果。
Timing test of numloops:1000
Total time of activate method:00:00:39
Total time of select method:00:00:01
Public Sub FreezePanesAt(rngDataTopLeft As Range)
Dim wndCurrent As Window
For Each wndCurrent In rngDataTopLeft.Worksheet.Parent.Windows
With wndCurrent
.FreezePanes = False
If Not ((rngDataTopLeft.Row = 1) And (rngDataTopLeft.Column = 1)) Then
.ScrollRow = 1
.ScrollColumn = 1
.SplitRow = rngDataTopLeft.Row - 1
.SplitColumn = rngDataTopLeft.Column - 1
.FreezePanes = True
End If
End With
Next
End Sub
Sub Format_Final_Report()
Dim DataWKB As Workbook
Set DataWKB = Workbooks("Report.xlsx")
Dim ws As Worksheet
Dim tabCNT As Long
Dim tabName As String
tabCNT = DataWKB.Sheets.Count
For i = 1 To tabCNT
Set ws = DataWKB.Worksheets(i)
tabName = ws.Name
With Application.Windows(DataWKB.Name)
Application.Goto ws.Cells(4, 5)
.SplitColumn = 4
.SplitRow = 3
.FreezePanes = True
End With
Next i
End Sub
Sub FreezePanes(nbLignes As Integer, nbColonnes As Integer, Optional ByVal feuille As Worksheet)
If feuille Is Nothing Then Set feuille = ActiveSheet Else feuille.Activate
Error GoTo erreur
With ActiveWindow
If .View = xlNormalView Then
If .FreezePanes Then .FreezePanes = False
If .Split Then .Split = False
.SplitColumn = nbColonnes
.SplitRow = nbLignes
If .Panes.Count = 4 Then 'rows and columns frozen
.Panes(1).ScrollRow = 1
.Panes(1).ScrollColumn = 1
.Panes(2).ScrollRow = 1 'top right pane
.Panes(3).ScrollColumn = 1 'bottom left pane
ElseIf nbLignes > 0 Then .Panes(1).ScrollRow = 1
ElseIf nbColonnes > 0 Then .Panes(1).ScrollColumn = 1
Else: GoTo erreur
End If
.FreezePanes = True
End If
End With
Exit Sub
erreur:
Debug.print "Erreur en exécutant le sub 'FreezePanes " & nbLignes & ", " & nbColonnes & ", '" & feuille.Name & "' : code #" & Err.Number & Err.Description
End Sub
9条答案
按热度按时间ztyzrc3y1#
拆分的问题是,如果用户解冻窗格,窗格将保持拆分状态(我找不到一种方法来关闭拆分,同时保持窗格冻结)。
这可能太明显/简单了,但是如果只是保存当前选择,然后重新选择呢?
whhtz7ly2#
这是我用的...
ngynwnxp3#
我用.Select和. activate做了一个冻结的计时测试。
这是结果。
如您所见,.Select的速度要快得多。
bfrts1fy4#
使用查看►冻结窗格►冻结顶行命令记录自己,这是.FreezePanes的结果。
因此,无论ActiveCell property是什么,修改.SplitColumn和/或.SplitRow属性都应该可以做到这一点。
jutyujz05#
关于冻结窗格有很多错误,我添加了我自己的答案,所以我会在这里找到它,而不必在下次重新发明它。
示例用法:
Application.Windows
(Windows(Thisworkbook.Name)
)不会导致错误dluptydi6#
我发现前面的答案只适用于
looping
到tabs
的一些工作表。我发现下面的代码适用于tab
到looped
的每个工作表(目标是单个workbook
),尽管workbook
是activeworkbook
。简而言之:
代码,因为它是在我的
Sub
:(请注意,我在这个子模块中做了更多的格式设置,我试图将其删除,只留下这里需要的代码)希望这能在将来为某人节省一些研究时间。
anhgbhbe7#
我需要能够正确地重新冻结窗格(特别是在创建新窗口时),而不丢失activecell或弄乱可见范围。这花了很多时间,但我认为我有一些坚实的工作:
lfapxunr8#
我知道这很老了,但是我发现了一个可能有用的小细节......正如ChrisB所说,SplitColumn/SplitRow值表示当前可见窗口的拆分BUT上方/左侧的最后一个单元格。
拆分将在行110和111之间进行,而不是行10和11之间进行。
编辑以进行澄清并添加更多信息:
我的观点是,这些值是左上角单元格的偏移量,而不是单元格的地址,因此,ChrisB在主要答案下的12月4日18:34的注解只有在第1行在Activewindow中可见时才有效。
关于这一点还有几点:
1.使用Application.后藤并不一定要将您要转到的单元格放在左上角
1.使用.后藤时放在左上角的单元格可以取决于excel窗口的大小、当前的缩放级别等(因此相当随意)
1.这是可能的有这分割被放置以致你不能看见他们或什至滚动在这可见的窗口(if .FreezePanes = true).例如:
CETAB可能会在他们的回答中处理这个问题。
wvt8vs2t9#
是的,如果您的可见窗口不包括单元格A1,则
ActiveWindow.ScrollRow = 1
和ActivWindow.ScrollColumn = 1
是FreezePane的必备项。如果通过选择行4或单元格A4冻结行1:3,并且单元格A3不可见,则FreezePanes函数将在可见窗口的中心冻结窗口。
同样,如果选择了单元格B4,并且A列不可见,则仅冻结行1:3(A列不冻结)。同样,如果行1:3不可见,则仅冻结A列。如果A列和行1:3都不可见,则FreezePanes函数将在可见窗口的中心冻结窗口。