如何在任何工作表中find真正的最后一个单元格

现在这个问题已经得到了很好的回答,多亏了Chris Neilsen,请看下面的答案。 这是我从现在开始使用的一个。 该解决scheme可靠地查找工作表中的最后一个单元格,即使单元格被filter,组或本地隐藏行隐藏。

讨论可能是一些信息,所以我也提供了我自己的代码的优化版本。 它演示了如何保存和恢复filter,使用@ Chis的想法来查找最后一行,并将Hidden Row Rangeslogging在一个简短的Variant数组中,最终从中恢复它们。

探索和testing所讨论的所有解决scheme的testing工作手册也可以在这里下载 。

完整的问题和讨论,如更新

有很多讨论在这里和其他地方findExcel工作表中的最后单元格。 Range.SpecialCells方法有局限性,并不总是find真正的最后一个单元格。 如果Worksheet.AutoFilters处于活动状态,则尤其如此。 下面的代码解决了这个问题,并返回正确的结果,即使筛选器处于活动状态,单元格分组和隐藏,或行或列使用隐藏/取消隐藏隐藏。 但是,这个方法并不简单。 有谁知道一个更好的方法是一贯可靠的吗?

“真正的最后一个单元格”被理解为包含数据或公式的最后一行与包含它们的最后一列的交集。 格式化可能会超过它。

感谢和好的想法: readify和sancho s 。

下面的代码在Excel 2010中的应用程序中进行testing和工作,并要求在VBIDE中引用Scripting.Runtime。 它包含内联评论,logging它在做什么,为什么。 另外,variables名是故意的解释。 对不起,但这让他们很长。

在某些情况下,它可能不会恢复被调用时隐藏的确切行。 我从来没有这样的事情发生过。

编辑1的问题

感谢3/2016年的3种回应。
这从brettdj标志着已经回答的问题。 遗憾的是,我不相信这是真的。 至less,除非UsedRange在任何情况下都可以被信任。 虽然SpecialCells的问题难以复制,但以前使用SpecialCells提供的价值的经验不利于对它们的依赖。

brettdj的post将范围从A1返回到最后一个使用的单元格提供了一个解决schemeGetRange 。 这是其中之一,但显然是最好的。 我已经testing了这个线程提出的所有解决scheme。 在我的testing中,当一个filter处于活动状态而不信任UsedRange时,它们都不能find最后一个单元格。 有很高的声誉的brettdj明显地认为,但在我看来,我真的已经发现了一个真正的问题。

展示:

见下面的testing表。 所有的行和列都在这个视图中显示。 在第19行中inputH19中的文本“Row to hide with filter”。 另请注意,B20中的第20行和J11中的J列中有信息。 (很明显,因为这是一个testing,所以J20中没有任何内容参考这个问题的正确答案): 测试工作表是所有的行和列暴露

testing在上面的表格上运行,但是filter处于活动状态(在下图中用红圈强调),从视图中删除第19行。 在testing过程中,J:K列已经崩溃,但19:20的Row Group仍然可见。

这些是结果(真正的答案是J20):

  • Gettrange()通过引用的答案中的brettdj给出“范围是A1:B20”。
  • 由Gary的学生给出的TrueLastCell()给出了“TRUE最后一个单元格是B20”,并且有时也可能是非常昂贵的,如果UsedRange走到大部分空白表的末尾,则从非常高的行和列号循环。 (另外,答案中的屏幕截图显示的是C11,应该是F11。)
  • 由PatrickK得到的GetTrueLastCell(WS)得到了正确的答案,J20,但它完全依赖于UsedRange,我知道这是不可能的,否则我将永远无法开始!
  • GetTrueLastCell(WS,,) (由我,下面的代码,虽然很复杂)给$ 20美元。

在这里输入图像说明

在不太可能的情况下,这是特定的操作系统,我的testing运行{你不能笑 – :)} Vista家庭高级版。 我的借口是,即使在老化的情况下,它也是一款闪电般的8核心机器上的64位操作系统。 Excel 2010,32位版本14.0.7166.5000。

编辑2作为回应

为了响应chris neilsen的validation请求和testingfile upload, 它已经不在这里了 。 简短的回答是: 在运行Office 2013 15.0.4797.1003的Windows 10以及Vista – Office 2010上,问题都是可重复的。不幸的是,这是真实的。 现在拍摄图像的工作手册包含了这里提出的每个build议的代码(截至2016年3月2日)。 公共文件下载好并在Windows 7 / Office 2010机器上复制结果。 要运行testing,请在VBIDE中查找Module TestSolutionsProposed。 testing的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 – 请你能恢复这个问题的状态吗? 当然这是可以被其他人重现的 – 结果如何能够针对我可以访问的三个独立的系统而不是其他的系统? 只有清除filter才能给出正确的答案。 注意:filter必须存在且处于活动状态才能显示问题; 如上传,testing工作簿设置为给出上述结果; AutoFitlerMode = True是不够的。 其中一个filter必须有一个过滤标准有效 – 在这个例子中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 

UsedRange可能是错误的(可能太大了) ,但是我们可以从外部的限制开始并向内工作:

 Sub TrueLastCell() Dim lr As Long, lc As Long, i As Long Dim wf As WorksheetFunction Set wf = Application.WorksheetFunction ActiveSheet.UsedRange With ActiveSheet.UsedRange lr = .Rows.Count + .Row - 1 lc = .Columns.Count + .Column - 1 End With For i = lr To 1 Step -1 If wf.CountA(Rows(i)) <> 0 Then Exit For End If Next i For i = lc To 1 Step -1 If wf.CountA(Cells(lr, i)) <> 0 Then MsgBox "The TRUE last cell is " & Cells(lr, i).Address(0, 0) Exit Sub End If Next i End Sub 

在这里输入图像说明

基于UsedRange的方法,但是当UsedRange时却被优化为快速工作,但不能反映真正的最后一个单元格(当工作表的极端单元格被无意地格式化时可能发生)

它的工作原理是,从UsedRange开始,根据计数结果计算一半范围内的单元格,并将分割点之上或之下的参考testing范围减半,然后重复,直到达到<30行/列,然后使用线性search那里。

 Function TrueLastCell( _ ws As Excel.Worksheet, _ Optional lRealLastRow As Long, _ Optional lRealLastColumn As Long _ ) As Range Dim lr As Long, lc As Long, i As Long Dim lr2 As Long, lc2 As Long Dim lr3 As Long, lc3 As Long Dim rng As Range Dim wf As WorksheetFunction Set wf = Application.WorksheetFunction Set rng = ws.Range(ws.Cells(1, 1), ws.UsedRange.Cells(ws.UsedRange.Cells.CountLarge)) With rng lr = .Rows.Count + .Row - 1 lc = .Columns.Count + .Column - 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 lc2 = lc \ 2 lc3 = lc2 \ 2 Do While (lc - lc2) > 30 'Debug.Print "c", lc2, lc If wf.CountA(.Range(.Cells(1, lc2), .Cells(lr, lc))) = 0 Then lc = lc2 lc2 = lc3 lc3 = lc2 \ 2 Else lc3 = lc2 lc2 = (lc + lc2) \ 2 End If Loop For i = lr To 1 Step -1 If wf.CountA(.Rows(i)) <> 0 Then Exit For End If Next i lr = i For i = lc To 1 Step -1 If wf.CountA(.Columns(i)) <> 0 Then Exit For End If Next i lc = i Set TrueLastCell = .Cells(lr, lc) lRealLastRow = lr lRealLastColumn = lc End With End Function 

在我的硬件上,它运行在大约4ms的表格上, UsedRange扩展到表格限制,True Last Cell在F5和0.2ms,当UsedRange反映F5最后一个单元

编辑:稍微更优化的search

伟大的问题。

正如你注意到的,用AutoFilter Find失败。 作为循环filter的替代方法,或者可以使用另一个答案使用的范围循环

  • 复制工作表并删除AutoFilter
  • Find例程中使用xlformulas ,以迎合隐藏的单元格

所以这样的事情:

 Sub GetRange() 'by Brettdj, http://stackoverflow.com/questions/8283797/return-a-range-from-a1-to-the-true-last-used-cell Dim rng1 As Range Dim rng2 As Range Dim rng3 As Range Dim ws As Worksheet With Application .EnableEvents = False .ScreenUpdating = False End With ActiveSheet.Copy Set ws = ActiveSheet With ws .AutoFilterMode = False Set rng1 = ws.Cells.Find("*", ws.[a1], xlFormulas, , xlByRows, xlPrevious) Set rng2 = ws.Cells.Find("*", ws.[a1], xlFormulas, xlPart, xlByColumns, xlPrevious) If Not rng1 Is Nothing Then Set rng3 = Range([a1], Cells(rng1.Row, rng2.Column)) MsgBox "Range is " & rng3.Address(0, 0) Debug.Print "Brettdj's GetRange gives: Range is " & rng3.Address(0, 0) 'added for this test by ND 'if you need to actual select the range (which is rare in VBA) Application.GoTo rng3 Else MsgBox "sheet is blank", vbCritical End If .Parent.Close False End With With Application .EnableEvents = True .ScreenUpdating = True End With End Sub 

我认为你可以利用Worksheet对象的.UsedRange属性。 试试下面:

 Option Explicit Function GetTrueLastCell(WS As Worksheet) As Range With WS If .UsedRange.Count = 1 Then Set GetTrueLastCell = .UsedRange Else Set GetTrueLastCell = .Range(Split(.UsedRange.Address, ":")(1)) End If End With End Function