如何在任何工作表

时间:2016-03-01 00:20:15

标签: excel vba excel-vba

这个问题现在得到了优雅的回答,感谢Chris Neilsen,请看下面的答案。这是我将从现在开始使用的那个。该解决方案可靠地查找工作表中的最后一个单元格,即使单元格被过滤器,组或本地隐藏行隐藏。

讨论可能对某些人有用,所以我也提供了我自己的代码的优化版本。它演示了如何保存和恢复过滤器,使用@ Chis的想法查找最后一行,并在一个简短的Variant数组中记录隐藏行范围,最终从中恢复它们。

download here也可以使用测试工作手册来探索和测试所讨论的所有解决方案。

完整的问题和讨论,更新

此处和其他地方有很多关于在Excel工作表中查找最后一个单元格的讨论。 Range.SpecialCells方法有局限性,并不总能找到真正的最后一个单元格。如果Worksheet.AutoFilters处于活动状态,则尤其如此。下面的代码解决了问题并返回了正确的结果,即使过滤器处于活动状态,单元格被分组和隐藏,或者行或列被隐藏使用隐藏/取消隐藏。但是,该方法并不简单。有人知道一种始终可靠的更好的方法吗?

真正的最后一个细胞'被理解为包含数据或公式的最后一行与包含它们的最后一列的交集。格式化可能会超出它。

致谢并感谢好主意:致readifysancho s

以下代码在Excel 2010中的应用程序中进行测试和工作,并要求在VBIDE中引用Scripting.Runtime。它包含内联注释,记录它正在做什么以及为什么。此外,变量名称是故意解释的。对不起,但这让他们很长。

在某些情况下,它可能无法恢复调用时隐藏的确切行数。我从未发生过这种情况。

编辑1到问题

感谢2016年1月3日的3种响应者 这是从brettdj标记问题已经回答的问题。遗憾的是,我不相信这是真的。至少,除非在所有情况下都可以信任UsedRange。尽管SpecialCells的问题难以重现,但是之前对SpecialCells提供的价值观的体验不鼓励对它们的依赖。

brettdj的帖子Return a range from A1 to the true last used cell提供了解决方案GetRange。它是其中之一,但似乎显然是最好的。我已经测试了它以及该线程中提出的所有解决方案。在我的测试中, none 能够在过滤器处于活动状态时找到最后一个单元而不信任UsedRangebrettdj,声誉很高,显然不这么认为,但在我看来,我确实发现了一个真正的问题。

演示:

请参阅以下测试表。在此视图中公开所有行和列。注意第19行,文本'行要隐藏过滤器'在H19。另请注意,B20第20行和J11第J列有信息。 (显然,由于这是一个测试,J20中没有任何内容,其参考是该问题的正确答案): Test Worksheet is it with all rows and columns exposed

测试在上面的工作表上运行,但过滤器处于活动状态(由下图中的红色圆圈强调),从视图中删除第19行。在测试过程中,柱组J:K被折叠,但是19:20的Row Group仍然可见。

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

    {li> Gettrange()在引用的brettdj中由Answer给出 "范围是A1:B20。" {li> TrueLastCell() Gary's Student给出" The 真正的最后一个细胞是B20"并且有时可能非常昂贵,如果UsedRange到达基本上空的Sheet的末尾,则从非常高的行和列号循环。 (另外,答案中的屏幕显示C11,应该是F11。) {li> GetTrueLastCell(WS) PatrickK得到了正确答案,J20但是 它完全依赖于UsedRange,我理解这是不可能的, 或者我永远不会开始这个!
  • GetTrueLastCell(WS,,)(由我,下面的代码,虽然很复杂)给出$ J $ 20.

enter image description here

在不太可能的情况下,这是特定于操作系统的,我的测试是在{你不允许笑 - :)} Vista Home Premium上运行的。我的理由是它是一台闪电般快速的8核机器上的64Bit操作系统,即使它已经老化了。 Excel 2010,32位版本14.0.7166.5000。

编辑2作为回应

回复chris neilsen的验证请求和上传测试文件it is no longer here。简短的回答是:问题在运行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

5 个答案:

答案 0 :(得分:3)

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

enter image description here

答案 1 :(得分:3)

基于@Gary的方法,但经过优化,可以在UsedRange很大但不能反映真实最后一个单元格的情况下快速工作(当工作表极端的单元格无意中被格式化时可能发生)

从UsedRange开始,按照计数结果计算单元格范围的一半,并将参考测试范围减半到分割点之上或之下,然后重复直到达到&lt; 30行/列,然后使用线性搜索。

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

在我的硬件上,它在一张工作表上运行大约4毫秒,其中UsedRange延伸到工作表限制,真实最后一个单元格在F5和0.2毫秒,当UsedRange反映{{1}时的真实最后一个单元格}

编辑:略微更优化的搜索

答案 2 :(得分:2)

很棒的问题。

正如您所注意到的,Find AutoFilter 相关。作为循环过滤器的替代方法,或另一个答案使用的范围循环,您可以

  • 复制工作表并移除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

答案 3 :(得分:0)

我认为您可以使用.UsedRange对象中的Worksheet属性。请尝试以下:

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

答案 4 :(得分:0)

我知道找到“真正的最后一个细胞”的最好方法是使用2个步骤:

  1. 选择UsedRange(即UsedRange.Cells.CountLarge)的最后一个单元格
  2. 向左和向上移动,直到找到CountA(即WorksheetFunction.CountA(Range))的最后一个非空行和列为止,因为它很快,并且可以与“隐藏” /“自动过滤” /“分组”范围一起使用。

这需要一些时间,因此我为第二步编写了优化的代码。 然后我发现 @Chris '代码于2019年11月30日编辑,看起来很相似,尽管我想知道为什么如此不同。我进行了比较(...尽我所能做到苹果对苹果),并对结果感到惊讶。

如果我的测试可靠,那么重要的是,您使用CountA进行了多少次搜索。我称之为循环-实际上是CountA个函数的数量! 我的例行程序最多可以执行34个周期,而 @Chris '例行程序最多可以执行32..80 +个周期。他的代码似乎可以反复测试相同的范围。

请查看测试表Link,在VBA注释中查看我的测试结果,并观看即时结果。您可以测试任何内容,甚至在自己的 WorkBook 中使用 ActiveSheet 。在VBA中的“ ====要更改的参数==== ”处播放参数。您可以放大至10%-15%,以查看显示每个周期搜索范围的绘制单元格。在那可以看到周期数。

注意:到目前为止,我还没有发现任何副作用或错误。我避免使用Range.Find,并在幕后更改其参数。有些用户将很难学习它-就像我一样,当我替换整个工作簿中的文本后,几天后才发现它。 注意2:这是我的第一篇文章,请原谅此处可能存在的故障。

Function GetLastSheetCellRng(ws As Excel.Worksheet) As Range
'Returns the [Range] of last used cell of the specified [Worksheet], located in the cross-section of the bottom row and right column with non-empty cells
Dim wf As Excel.WorksheetFunction: Set wf = Application.WorksheetFunction
Dim Xfound&, Yfound&, Xfirst&, Yfirst&, Xfrom&, Yfrom&, Xto&, Yto As Long

With ws
    '1. step: UsedRange last cell
    Set GetLastSheetCellRng = .UsedRange.Cells(.UsedRange.Cells.CountLarge) 'Getting UsedRange last cell
    Yfound = GetLastSheetCellRng.Row: Xfound = GetLastSheetCellRng.Column

    '2. step: Check non-empty cells in UsedRange last cell row & column
    'If not found, then search up for last non-empty row, and search left for last non-empty column
    If (wf.CountA(.Rows(Yfound)) = 0) And (Yfound > 1) Then
        Yto = Yfound
        Yfrom = Yto \ 2
        Yfirst = 0
        Do
            If wf.CountA(.Range(.Rows(Yfrom), .Rows(Yto))) <> 0 Then
                Yfirst = Yfrom
                Yfrom = (Yfirst + Yto + 0.5) \ 2
            Else
                Yto = Yfrom - 1
                Yfrom = (Yfrom + Yfirst) \ 2
            End If
        Loop Until Yfirst = Yfrom
        If Yfirst = 0 Then
            Yfound = 1 'If no cell found, then 1st row returned
        Else
            Yfound = Yfirst
        End If
    End If
    If (wf.CountA(.Columns(Xfound)) = 0) And (Xfound > 1) Then
        Xto = Xfound
        Xfrom = Xto \ 2
        Xfirst = 0
        Do
            If wf.CountA(.Range(.Columns(Xfrom), .Columns(Xto))) <> 0 Then
                Xfirst = Xfrom
                Xfrom = (Xfirst + Xto + 0.5) \ 2
            Else
                Xto = Xfrom - 1
                Xfrom = (Xfrom + Xfirst) \ 2
            End If
        Loop Until Xfirst = Xfrom
        If Xfirst = 0 Then
            Xfound = 1 'If no cell found, then 1st column returned
        Else
            Xfound = Xfirst
        End If
    End If
    Set GetLastSheetCellRng = .Cells(Yfound, Xfound)
End With
End Function