2016-03-01 13 views
5

Diese Frage wird jetzt elegant beantwortet, danke an Chris Neilsen, siehe die Antwort unten. Es ist derjenige, den ich von jetzt an verwenden werde. Die Lösung findet zuverlässig die letzte Zelle in einem Arbeitsblatt, selbst wenn Zellen durch Filter, Gruppen oder lokales Ausblenden von Zeilen ausgeblendet sind.So finden Sie die wahre letzte Zelle in einem Arbeitsblatt

Die Diskussion kann für einige informativ sein, so habe ich auch eine optimierte Version meines eigenen Codes zur Verfügung gestellt. Es zeigt, wie man Filter speichert und wiederherstellt, verwendet die @ Chis-Ideen zum Auffinden der letzten Zeile und zeichnet Versteckte Zeilenbereiche in einem kurzen Variant-Array auf, aus dem sie schließlich wiederhergestellt werden.

Ein Testarbeitsbuch, das alle vorgeschlagenen Lösungen untersucht und testet, steht auch unter download here zur Verfügung.

die vollständige Frage und Diskussion, da es viel Diskussion hier und anderswo auf der Suche nach der letzten Zelle in Excel-Tabellen

AKTUALISIERT. Die Range.SpecialCells Methode hat Einschränkungen und findet nicht immer die wahre letzte Zelle. Dies gilt insbesondere, wenn Worksheet.AutoFilters aktiv sind. Der folgende Code löst das Problem und gibt das richtige Ergebnis zurück, auch wenn Filter aktiv sind, Zellen gruppiert und verborgen sind oder Zeilen oder Spalten durch Ein-/Ausblenden ausgeblendet sind. Die Methode ist jedoch nicht einfach. Kennt jemand eine bessere Methode, die durchweg zuverlässig ist?

Die 'wahre letzte Zelle' wird als Schnittpunkt der letzten Zeile mit Daten oder Formeln und der letzten Spalte, die sie enthält, verstanden. Die Formatierung kann darüber hinausgehen.

Dank und Dank für gute Ideen: zu readify und .

Der folgende Code testet und funktioniert in meiner Anwendung in Excel 2010 und erfordert, dass Scripting.Runtime in der VBIDE verwiesen wird. Es enthält Inline-Kommentare, die dokumentieren, was es macht und warum. Auch die Variablennamen sind absichtlich erklärend. Entschuldigung, aber das macht sie lang.

Unter bestimmten Umständen kann es die genauen Zeilen nicht wiederherstellen, die beim Aufruf verborgen waren. Das ist mir noch nie passiert.

Edit 1 auf die Frage

Dank der Art 3 Antworten eingegangen am 2016.01.03.
Dies folgt auf brettdj Kennzeichnung der Frage als bereits beantwortet. Bedauerlicherweise glaube ich das nicht, um wahr zu sein. Zumindest nicht, es sei denn, UsedRange kann unter allen Umständen vertraut werden. Obwohl Probleme mit SpecialCells schwer zu reproduzieren sind, raten frühere Erfahrungen mit den von SpecialCells bereitgestellten Werten davon ab, sich auf sie zu verlassen.

brettdj Post Return a range from A1 to the true last used cell bietet eine Lösung, GetRange. Es ist eins unter anderem, scheint aber eindeutig das Beste zu sein. Ich habe es und alle in diesem Thread vorgeschlagenen Lösungen getestet. In meinen Tests keine von ihnen sind in der Lage, die letzte Zelle zu finden, wenn ein Filter aktiv ist, ohne zu vertrauen UsedRange. brettdj, von hohem Ansehen, denkt eindeutig anders, aber es scheint mir, dass ich wirklich ein echtes Problem entdeckt habe.

Um zu demonstrieren:

das folgende Testblatt. Alle Zeilen und Spalten werden in dieser Ansicht angezeigt. Beachten Sie Zeile 19 mit dem Text 'Zeile zum Ausblenden mit Filter' in H19. Beachten Sie auch, dass in Zeile 20 bei B20 und in Spalte J bei J11 Informationen vorhanden sind.(Offensichtlich, da dies ein Test ist, gibt es nichts in J20 die Zelle, deren Referenz ist die richtige Antwort auf die Frage): Test Worksheet is it with all rows and columns exposed

Tests wurden auf dem Blatt laufen oben, aber mit einem Filter aktiv (hervorgehoben durch eine rote Kreis in der Abbildung unten), die Zeile 19 aus der Ansicht entfernt. Während der Tests war die Spaltengruppe J: K kollabiert, aber die Zeilengruppe über 19:20 war sichtbar.

Dies sind die Ergebnisse (die wahre Antwort J20 ist):

  • Gettrange() von brettdj in der referenzierten Answer gibt "Bereich ist. A1: B20"
  • TrueLastCell() durch Gary's Student gibt "Die WAHR letzte Zelle ist B20" und kann auch manchmal sehr teuer sein, Schleifen von sehr hohen Zeilen- und Spaltennummern, wenn der UsedRange an das Ende eines weitgehend leeren Blatt geht. (Außerdem zeigt die Screenshot in der Antwort C11, wenn es F11 sein sollte.)
  • GetTrueLastCell(WS) von PatrickK bekommt die richtige Antwort, J20 aber es ganz auf Usedrange setzt die ich verstehe nicht möglich ist, oder ich würde nie haben damit begonnen!
  • GetTrueLastCell(WS,,) (von mir, der Code unten, obwohl kompliziert) gibt $ J $ 20.

enter image description here

Im unwahrscheinlichen Fall, dass dieses System spezifisch arbeitet, wurde mein Test laufen auf {Sie lachen nicht erlaubt - :)} Vista Home Premium. Meine Entschuldigung ist, dass es 64Bit OS auf einer blitzschnellen 8-Kern-Maschine ist, auch wenn es älter wird. Excel 2010, 32-Bit-Version 14.0.7166.5000.

Edit 2 in Reaktion

Als Reaktion auf chris neilsen den Antrag für die Validierung und eine Testdatei it is no longer here hochladen. Die kurze Antwort lautet: Das Problem ist auf Windows 10 mit Office 2013 15.0.4797.1003 sowie auf Vista - Office 2010 alles andere als reproduzierbar. Leider ist das real. Das Arbeitsbuch, aus dem die Bilder stammen, enthält nun den Code für die hier gemachten Vorschläge (bis zum 2. März 2016). Die öffentliche Datei wird heruntergeladen und reproduziert die Ergebnisse auf einem Windows 7/Office 2010-Computer. Suchen Sie nach dem Modul TestSolutionsProposed in dem VBIDE, um die Tests auszuführen. Die Debug.Prints aus den Tests ergeben identisch gleiche Ergebnisse auf W10, W7, Vista und Office 2010 & 2013 (richtige Antwort ist 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 - bitte können Sie den Status dieser Frage wiederherstellen ? Sicherlich ist es von anderen reproduzierbar - wie könnten die Ergebnisse für drei verschiedene Systeme spezifisch sein, auf die ich zugreifen kann, aber nicht für andere? Nur die Entfernung der Filter gibt die richtige Antwort. Hinweis: Der Filter muss sowohl vorhanden als auch aktiv sein, um das Problem zu zeigen. Wie hochgeladen, wird die Testarbeitsmappe so eingestellt, dass sie die obigen Ergebnisse liefert; es reicht nicht, AutoFitlerMode = True zu haben. Einer der Filter muss ein Filterkriterium aktiv haben - im Beispiel ist H19 ausgeblendet.

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 
+0

Der Suche Code funktioniert für mich auf F Durchgestrichene und/oder ausgeblendete Zeilen/Spalten ** ohne ** das Entfernen der Filter/Ausblenden (dh das Ausführen des Find-Teils) in Excel 2007. Haben Sie überprüft, ob Sie die Filter in Ihrer Version entfernen müssen? –

+0

Nach Ihrer Bearbeitung habe ich erneut getestet und ** kann Ihr Problem nicht reproduzieren **. 'Find' alleine findet zuverlässig die wahre letzte Zelle. Ich schlage vor, dass Sie Ihre Testdatei hochladen. –

+0

Ich habe die Post bearbeitet, die vollständigen Testdetails und einen Link zum Testarbeitsbuch, das jetzt alle vorgeschlagenen Lösungen enthält. Keine von ihnen funktioniert. Ich bin nicht sicher, wie man Brettdj erhält, um diese Frage wieder herzustellen .... –

Antwort

3

UsedRange fehlerhaft sein kann, (es kann zu groß sein), aber wir können mit ihren äußeren Grenzen beginnen und nach innen arbeiten:

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

0

Ich denke, man kann Verwenden Sie die .UsedRange-Eigenschaft aus dem Objekt Worksheet. Versuchen Sie unter:

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 
3

Basierend auf @ Gary Methode, aber optimiert schnell zu arbeiten, wenn die UsedRange Large ist aber nicht repräsentativ für die wahre letzte Zelle (wie geschehen kann, wenn eine Zelle auf den Extremen eines Arbeitsblatt versehentlich formatiert ist)

Es beginnt mit dem UsedRange, zählt Zellen in der Hälfte des Bereichs und halbiert den referenzierten Testbereich über oder unter dem Splitpunkt abhängig vom Zählergebnis und wiederholt, bis es < 30 Zeilen/Spalten erreicht verwendet eine lineare Suche von dort.

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 

Auf meiner Hardware läuft es in etwa 4 ms auf einem Blatt mit UsedRange auf die Blattgrenzen und True letzte Zelle erstreckt bei F5 und 0,2 ms bei Usedrange die wahren letzte Zelle bei F5

bearbeiten widerspiegelt: leicht mehr optimierte Suche

+0

Ich stellte die Frage und das ist die Lösung, die ich verwenden werde. Danke an @Chris –

2

Große Frage.

Wie Sie bemerken, Find Failes mit AutoFilter. Als Alternative durch die Filter zu Looping, oder das durch eine andere Antwort verwendete Schleife könnte man

  • kopiert das Blatt und die AutoFilter
  • Verwendung xlformulas in der Find Routine entfernen, die
  • zu versteckten Zellen bietet

So etwas lke dies:

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 
+0

Das ist ein Gedanke. Der resultierende Code ist nett und kurz. Ist das wahrscheinlich schneller als die chris neilsen Methode? Ich bin mir nicht sicher, ob das Kopieren von Blättern eine intrinsisch schnelle oder langsame Operation ist. Seit der Einführung der Chris Neilsen-Methode hatte ich nur einmal Probleme damit und es schien eine Excel-Instabilität zu sein; Das System hat CountA als Arbeitsblattfunktion nicht erkannt. Excel herunterzufahren und neu zu starten behob das Problem. –

Verwandte Themen