如何在任何工作表中找到真正的最后一个单元格
Nei*_*lop 5 excel vba excel-vba
这个问题现在得到了优雅的回答,感谢Chris Neilsen,请看下面的答案.这是我将从现在开始使用的那个.该解决方案可靠地查找工作表中的最后一个单元格,即使单元格被过滤器,组或本地隐藏行隐藏.
讨论可能对一些人有用,所以我也提供了我自己的代码的优化版本.它演示了如何保存和恢复过滤器,使用@ Chis的想法查找最后一行,并在一个简短的Variant数组中记录隐藏行范围,最终从中恢复它们.
还可以在此处下载探索和测试所讨论的所有解决方案的测试工作簿.
完整的问题和讨论,更新
这里和其他地方有很多关于在Excel工作表中查找最后一个单元格的讨论.该Range.SpecialCells方法有局限性,并不总能找到真正的最后一个单元格.如果Worksheet.AutoFilters处于活动状态,则尤其如此.下面的代码解决了问题并返回了正确的结果,即使过滤器处于活动状态,单元格被分组和隐藏,或者行或列被隐藏使用隐藏/取消隐藏.但是,该方法并不简单.有人知道一种始终可靠的更好的方法吗？
"真正的最后一个单元格"被理解为包含数据或公式的最后一行与包含它们的最后一列的交集.格式化可能会超出它.
下面的代码在我的Excel 2010应用程序中测试和工作,并要求在VBIDE中引用Scripting.Runtime.它包含内联注释,记录它正在做什么以及为什么.此外,变量名称是故意解释的.对不起,但这让他们很长.
在某些情况下,它可能无法恢复调用时隐藏的确切行.我从未发生过这种情况.
编辑1到问题
感谢2016年1月3日的3种响应者.
这是继brettdj之后标记问题已经回答的问题.遗憾的是,我不相信这是真的.至少,除非UsedRange在所有情况下都可以信任.尽管SpecialCells的问题很难再现,但是之前对SpecialCells提供的价值观的体验不鼓励对它们的依赖.
brettdj的帖子返回从A1到最后一个使用过的单元格的范围提供了一个解决方案GetRange.它是其中之一,但似乎显然是最好的.我已经测试了它以及该线程中提出的所有解决方案.在我的测试中,当过滤器处于活动状态而没有信任时,它们都没有能够找到最后一个单元格UsedRange. brettdj,声誉很高,显然不这么认为,但在我看来,我确实发现了一个真正的问题.
展示:
请参阅以下测试表.在此视图中公开所有行和列.请注意第19行,其中包含H19中"用过滤器隐藏的行"文本.另请注意,B20第20行和J11第J列有信息.(显然,由于这是一个测试,J20中没有任何内容,其参考是该问题的正确答案):
测试在上面的工作表上运行,但过滤器处于活动状态(由下图中的红色圆圈强调),从视图中删除第19行.在测试期间,柱组J:K被折叠,但是19:20的Row Group仍然可见.
这些是结果(真正的答案是J20):
Gettrange()由brettdj在引用的答案中给出"范围是A1:B20".TrueLastCell()由Gary的学生给出"真正的最后一个单元格是B20"并且有时可能非常昂贵,如果UsedRange到达一个很大空的工作表的末尾,则从非常高的行和列数循环.(此外,答案中的屏幕显示C11,应该是F11.)GetTrueLastCell(WS)通过PatrickK获得正确的答案,J20但它完全依赖于UsedRange,我理解这是不可能的,或者我永远不会开始这个!GetTrueLastCell(WS,,)(通过我,下面的代码虽然很复杂)给出$ 20 $.
在不太可能的情况下,这是特定于操作系统,我的测试是在{你不允许笑 - :)} Vista Home Premium.我的理由是它是一台闪电般快速的8核机器上的64Bit操作系统,即使它已经老化了.Excel 2010,32位版本14.0.7166.5000.
编辑2作为回应
为响应chris neilsen的验证请求和测试文件上传,它不再在这里.简短的回答是:在运行Office 2013 15.0.4797.1003以及Vista - Office 2010的Windows 10上,问题太可重现了.可悲的是,这是真的. 现在拍摄图像的工作簿包含了每个建议的代码(截至2016年3月2日).公共文件下载正常并在Windows 7/Office 2010计算机上重现结果.要运行测试,请在VBIDE中查找Module TestSolutionsProposed.测试中的Debug.Prints在W10,W7,Vista和Office 2010&2013上给出相同的相同结果(正确答案是J20):
Brettdj's GetRange gives: Range is A1:B20
WS usedrange = $A$1:$K$20
PatrickK's GetTrueLastCell gives Found last cell = $K$20
Gary's Student's TrueLastCell gives: The TRUE last cell is B20
My GetTrueLastCell (with RemoveFiltersAsBoolean = False) gives: Last cell address is B20
My GetTrueLastCell (with RemoveFiltersAsBoolean = True) gives: Last cell address is J20
@brettdj - 请你恢复这个问题的状态吗？ 当然,它可以被其他人重现 - 结果如何能够特定于我可以访问而不是其他人的三个独立系统？只有删除过滤器才能给出正确的答案.注意:过滤器必须同时存在且处于活动状态才能显示问题; 在上传时,测试工作簿将设置为给出上述结果; 这还不够AutoFitlerMode = True.其中一个过滤器必须激活过滤条件 - 在示例中隐藏了H19.
Private Function GetTrueLastCell(ws As Excel.Worksheet, _
Optional lRealLastRow As Long, _
Optional lRealLastColumn As Long, _
Optional RemoveFiltersAsBoolean As Variant = False) As Range
'Purpose:
'Finds the cell at the intersection of the last Row containing any data and the last Column containing any data,
' even if some cells are hidden by Filters, Grouping or are locally Hidden. If there are no filters uses a simple method.
'Returns: the LastCell as a Range; Optionally returns Row and Column indeces.
' If the WS has no data or is not a WS, returns GetTrueLastCell=Nothing & lRealLastRow=0 & RealLastColumn=0
'Developed by extension of ideas from:
' 'Readify' for ideas about saving and restoring filters,
' see: https://stackoverflow.com/questions/9489126/in-excel-vba-how-do-i-save-restore-a-user-defined-filter
' 'Sancho s' 24/12/2014, see https://stackoverflow.com/questions/24612874/finding-the-last-cell-in-an-excel-sheet
'Written by Neil Dunlop 29/2/2016
'History: 2016 03 03 added optimisation of the reapplication of filters following discussion on StackOverFlow wiht
' thanks to Chris Neilsen for review and comments and ideas - see here:
' https://stackoverflow.com/questions/35712424/how-to-find-the-true-last-cell-in-any-worksheet
'Notes:
'This will find the last cell even if rows are Hidden by any means.
' This is partly accomplished by setting Lookin:=xlFormulas,
' and partly by removing and restoring filters that prevent .Find looking in a cell.
'Requirements:
' The reference to Microsoft Scripting Runtime must be present in the VBIDE's Tools>References list.
Dim FilteredRange As Range, rng As Range
Dim wf As Excel.WorksheetFunction
Dim MyCriteria1 As Scripting.Dictionary
Dim lr As Long, lr2 As Long, lr3 As Long
Dim i As Long, j As Long, NumFilters As Long
Dim CurrentScreenStatus As Boolean, LastRowHidden As Boolean
Dim FilterStore() As Variant, OutlineHiddenRow() As Variant
If Not RemoveFiltersAsBoolean Then GoTo JUSTSEARCH
CurrentScreenStatus = Excel.Application.ScreenUpdating
Excel.Application.ScreenUpdating = False
On Error GoTo BADWS
If ws.AutoFilterMode Then
'Save all active Filters
With ws.AutoFilter
If .Filters.Count > 0 Then
Set FilteredRange = .Range
For i = 1 To .Filters.Count
If .Filters(i).On Then
NumFilters = NumFilters + 1
ReDim Preserve FilterStore(0 To 4, 1 To NumFilters)
FilterStore(0, NumFilters) = i 'The Column to which the filter applies
'If there are only 2 Filters they will be in Criteria1 and Criteria2.
'Above 2 Filters, Criteria1 contains all the filters in a Scripting Dictionary
FilterStore(1, NumFilters) = .Filters(i).Count 'The number of conditions active within this filter
Select Case .Filters(i).Count
Case Is = 1 'There is 1 filter in Criteria1
FilterStore(2, NumFilters) = .Filters(i).Criteria1
Case Is = 2 'There are 2 Filters in Criteria1 and Criteria2
FilterStore(2, NumFilters) = .Filters(i).Criteria1
FilterStore(3, NumFilters) = .Filters(i).Criteria2
Case Else 'There are many filters, they need to be in a Scripting Dictionary in Criteria1
Set MyCriteria1 = CreateObject("Scripting.Dictionary")
MyCriteria1.CompareMode = vbTextCompare
For j = 1 To .Filters(i).Count
MyCriteria1.Add Key:=CStr(j), Item:=.Filters(i).Criteria1(j)
Next j
Set FilterStore(2, NumFilters) = MyCriteria1
End Select
If .Filters(i).Operator Then
FilterStore(4, NumFilters) = .Filters(i).Operator
End If
End If
Next i
End If ' .Filters.Count > 0
End With
'Check for and store any hidden Outline levels applied to the Rows.
'At this stage the last cell is not known, so the best available estimate , UsedRange,
' is used in the Row loop. The true maximum row number with data may be less than the
' highest row from UsedRange. The code below reduces the maximum estimated efficiently.
'It is believed that UsedRange is never too small; it it were, then the hidden properties
' of some rows may not be stored and will therefore not be restored later.
'---------get a true last row---------------------------------------------------------
Set rng = ws.Range(ws.Cells(1, 1), ws.UsedRange.Cells(ws.UsedRange.Cells.CountLarge))
Set wf = Application.WorksheetFunction
With rng 'Code from Chris Neilsen
lr = .Rows.Count + .Row - 1
lr2 = lr \ 2
lr3 = lr2 \ 2
Do While (lr - lr2) > 30
'Debug.Print "r", lr2, lr
If wf.CountA(.Rows(lr2 & ":" & lr)) = 0 Then
lr = lr2
lr2 = lr3
lr3 = lr2 \ 2
Else
lr3 = lr2
lr2 = (lr + lr2) \ 2
End If
Loop
For i = lr To 1 Step -1
If wf.CountA(.Rows(i)) <> 0 Then Exit For
Next i
lr = i
End With ' rng
'---------record and unhide any hidden Row--------------------------------------------
j = 0
LastRowHidden = False
For i = 1 To lr
If (Not ws.Rows(i).Hidden And LastRowHidden) Then
'End of a Hidden Rows Range, record the Range
Set OutlineHiddenRow(2, j) = ws.Rows(OutlineHiddenRow(1, j) & ":" & i - 1)
LastRowHidden = False
ElseIf ws.Rows(i).Hidden And Not LastRowHidden Then 'Start of Hidden Rows Range, record the Row
j = j + 1
ReDim Preserve OutlineHiddenRow(1 To 2, 1 To j) ' 1 -first row found to be Hidden, 2 - Range of Hidden Rows(i:j)
If i <> lr Then
OutlineHiddenRow(1, j) = i
LastRowHidden = True
Else 'Last line in range is hidden all on its own
Set OutlineHiddenRow(2, j) = ws.Rows(i & ":" & i)
End If
ElseIf LastRowHidden And ws.Rows(i).Hidden And i = lr Then 'Special case is for Hidden Range ending on last Row
Set OutlineHiddenRow(2, j) = ws.Rows(OutlineHiddenRow(1, j) & ":" & i)
Else
'Nothing to do
End If
Next i
NumFilters = j
'Remove the AutoFilter, if any of the filters were On.
' This changes the hidden setting for ALL Rows (but NOT Columns) to visible
' irrespective of the reason for their having become hidden (Filter, Group, local Hide).
If NumFilters > 0 Then ws.AutoFilterMode = False
End If ' WS.AutoFilterMode
JUSTSEARCH:
'Search for the last cell that contains any sort of 'formula'.
'xlPrevious ensures that the search starts from the end of the last Row or Column (it's the next cell after (1,1)).
'LookIn:=xlFormulas ensures that the search includes a search across Hidden data.
' However, if ANY filters are active the search NO LONGER LOOKS IN HIDDEN CELLS. Also the reverse search
' starts at the end of the column or row containing (1,1) instead of starting at the very end row and column.
' This is why all filters have to be stored, removed and reapplied to find the correct end cell.
lRealLastColumn = ws.Cells.Find(What:="*", _
After:=ws.Cells(1, 1), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False, _
MatchByte:=False, _
SearchFormat:=False).Column
If lr = 0 Then
lRealLastRow = ws.Cells.Find(What:="*", _
After:=ws.Cells(1, 1), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False, _
MatchByte:=False, _
SearchFormat:=False).Row
Else
lRealLastRow = lr
End If
Set GetTrueLastCell = ws.Cells(lRealLastRow, lRealLastColumn)
'Restore the saved Filters to their Rows.
If NumFilters Then
'Restore the original AutoFilter settings
FilteredRange.AutoFilter
With ws.AutoFilter
For i = 1 To UBound(FilterStore, 2)
If FilterStore(4, i) Then 'There is an Operator
If FilterStore(1, i) > 2 Then 'There is a ScriptingDictionary for Criteria1
FilteredRange.AutoFilter Field:=FilterStore(0, i), _
Criteria1:=FilterStore(2, i).Items, _
Criteria2:=FilterStore(3, i), _
Operator:=FilterStore(4, i)
Else 'Criteria 1 is a string
FilteredRange.AutoFilter Field:=FilterStore(0, i), _
Criteria1:=FilterStore(2, i), _
Criteria2:=FilterStore(3, i), _
Operator:=FilterStore(4, i)
End If
Else 'No Operator
If FilterStore(1, i) > 2 Then 'There is a ScriptingDictionary for Criteria1
FilteredRange.AutoFilter Field:=FilterStore(0, i), _
Criteria1:=FilterStore(2, i).Items
Else 'Criteria 1 is a string
FilteredRange.AutoFilter Field:=FilterStore(0, i), _
Criteria1:=FilterStore(2, i)
End If
End If
Next i
End With
End If ' NumFilters
If NumFilters > 0 Then
'Restore the Hidden status of any Rows that were revealed by setting WS.AutoFilterMode = False.
'Rows, not columns are filtered. Columns' Hidden status does not need to be restored
' because AutoFilter does not unhide Columns.
For i = 1 To NumFilters
OutlineHiddenRow(2, i).Hidden = True 'Restore the hidden property to the stored Row Range
Next i
End If ' NumFilters > 0
GoTo ENDFUNCTION
BADWS:
lRealLastRow = 0
lRealLastColumn = 0
Set GetTrueLastCell = Nothing
ENDFUNCTION:
Set wf = Nothing
Set MyCriteria1 = Nothing
Set FilteredRange = Nothing
Excel.Application.ScreenUpdating = CurrentScreenStatus
End Function
基于@Gary 的方法，但优化为在UsedRange较大但不反映真正的最后一个单元格时快速工作（当工作表极端上的单元格被无意格式化时可能会发生这种情况）
它的工作原理是，从 UsedRange 开始，计算一半范围内的单元格，并根据计数结果将分割点上方或下方的引用测试范围减半，然后重复直到达到 < 5 行/列，然后使用线性搜索从那里。
Function TrueLastCell( _
ws As Excel.Worksheet, _
Optional lRealLastRow As Long, _
Optional lRealLastColumn As Long _
) As Range
Dim lrTo As Long, lcTo As Long, i As Long
Dim lrFrom As Long, lcFrom As Long
Dim wf As WorksheetFunction
Set wf = Application.WorksheetFunction
With ws.UsedRange
lrTo = .Rows.Count
lcTo = .Columns.Count
lrFrom = lrTo \ 2
Do While (lrTo - lrFrom) > 2
If wf.CountA(.Rows(lrFrom & ":" & lrTo)) = 0 Then
lrTo = lrFrom - 1
lrFrom = lrFrom \ 2
Else
lrFrom = (lrTo + lrFrom) \ 2
End If
Loop
If wf.CountA(.Rows(lrFrom & ":" & lrTo)) = 0 Then
lrTo = lrFrom - 1
Else
For i = lrTo To lrFrom Step -1
If wf.CountA(.Rows(i)) <> 0 Then
Exit For
End If
Next i
lrTo = i
End If
lcFrom = lcTo \ 2
Do While (lcTo - lcFrom) > 2
If wf.CountA(Range(.Columns(lcFrom), .Columns(lcTo))) = 0 Then
lcTo = lcFrom - 1
lcFrom = lcFrom \ 2
Else
lcFrom = (lcTo + lcFrom) \ 2
End If
Loop
If wf.CountA(Range(.Columns(lcFrom), .Columns(lcTo))) = 0 Then
lcTo = lcFrom - 1
Else
For i = lcTo To 1 Step -1
If wf.CountA(.Columns(i)) <> 0 Then
Exit For
End If
Next i
lcTo = i
End If
Set TrueLastCell = .Cells(lrTo, lcTo)
lRealLastRow = lrTo + .Row - 1
lRealLastColumn = lcTo + .Column - 1
End With
End Function
在我的硬件上，它在工作表上运行大约 2ms，UsedRange扩展到工作表限制和 True Last Cell at F5，当 UsedRange 反映 True Last Cell 时为 0.1msF5
编辑：稍微优化的搜索