Excel & VBa: find last row, column, cell in an Excel (work)sheet

marko1981

Source:  
      http://www.ozgrid.com/VBA/ExcelRanges.htm : [Goto this site ]
        
      The following page contains some usefull (general) vba code that can be
      used to find the last row, column and/or cell in an Excel (work)sheet.
      Find the last used cell, before a blank in a Column:
      Sub LastCellBeforeBlankInColumn()
        Range("A1").End(xldown).Select
      End Sub

      Find the very last used cell in a Column:
      Sub LastCellInColumn()
        Range("A65536").End(xlup).Select
      End Sub
     
      Find the last cell, before a blank in a Row:
      Sub LastCellBeforeBlankInRow()
        Range("A1").End(xlToRight).Select
      End Sub

      Find the very last used cell in a Row:
      Sub LastCellInRow()
        Range("IV1").End(xlToLeft).Select
      End Sub

      Find the very last used cell on a Worksheet:
      Sub Demo()
        Cells.Find(What:="*", After:=[A1], SearchDirection:=xlPrevious).Select
      End Sub

        
      Find the last used Row on a Worksheet:
      Sub FindLastRow()
        Dim LastRow As Long

        If WorksheetFunction.CountA(Cells) > 0 Then
          'Search for any entry, by searching backwards by Rows.
          LastRow = Cells.Find(What:="*", After:=[A1], _
                               SearchOrder:=xlByRows, _
                               SearchDirection:=xlPrevious).Row
          MsgBox LastRow
        End If
      End Sub

      Find the last used Column on a Worksheet:
      Sub FindLastColumn()
        Dim LastColumn As Integer
        If WorksheetFunction.CountA(Cells) > 0 Then
          'Search for any entry, by searching backwards by Columns.
          LastColumn = Cells.Find(What:="*", After:=[A1], _
                                  SearchOrder:=xlByColumns, _
                                  SearchDirection:=xlPrevious).Column
          MsgBox LastColumn
        End If
      End Sub
        
      Find the last used Cell on a Worksheet:
      Private Sub FindLastCell()
        Dim LastColumn As Integer
        Dim LastRow As Long
        Dim LastCell As Range
        If WorksheetFunction.CountA(Cells) > 0 Then
          'Search for any entry, by searching backwards by Rows.
          LastRow = Cells.Find(What:="*", After:=[A1], _
                               SearchOrder:=xlByRows, _
                               SearchDirection:=xlPrevious).Row
          'Search for any entry, by searching backwards by Columns.
          LastColumn = Cells.Find(What:="*", After:=[A1], _
                                  SearchOrder:=xlByColumns, _
                                  SearchDirection:=xlPrevious).Column
          MsgBox Cells(LastRow, LastColumn).Address
        End If
      End Sub  
        
      Add a row at each change in a column.
      Assume you have a long list of data and you want to insert a row at each
      change. While you could use a simple Loop this method is much faster. The
      Data must be sorted!
        
      Option Explicit

      Private Sub InsertRowAtEachChange()
        Dim objRange As Excel.Range

        ''' On error goto the error handler defined in the lower part of this
      function.
        On Error GoTo ErrHandler

        ''' Ensure an entire Column is selected
        If Selection.Cells.Count <> 65536 Then
          Call MsgBox("You must select an entire column", vbCritical)
          End
        End If
        
        '''Set a range variable to all data in selected column
        Set objRange = Range(Selection.Cells(2, 1), Selection.Cells(65536,
      1).End(xlUp))

        ''' Add a column for formulas
        With objRange
          .EntireColumn.Insert
          .Offset(0, -1).FormulaR1C1 = "=IF(AND(NOT(ISNA(R[-1]C))," & _
                                       "R[-1]C[1]<>RC[1]),0,"""")"
          ''' Convert to values
          .Offset(0, -1) = .Offset(0, -1).Value
          ''' Set variable to 0
          Set objRange = .Offset(0, -1).SpecialCells(xlCellTypeConstants,
      xlNumbers)
        End With
         
        ''' Add a row at each 0
        If WorksheetFunction.CountIf(objRange, 0) > 0 Then
          Call objRange.EntireRow.Insert
        End If
        
        ''' Reset variable for next formulas
        Set objRange = Range(Selection.Cells(2, 1), Selection.Cells(65536,
      1).End(xlUp))
        
        ''' Add the formula to add 0
        objRange.FormulaR1C1 = "=IF(OR(RC[1]="""",R[-1]C[1]=""""),""""," & _
                               "IF(RC[1]<>R[-1]C[1],0))"
        ''' Convert to values
        objRange = objRange.Value
        
        ''' Set variable to 0 cells if any
        If WorksheetFunction.CountIf(objRange, 0) > 0 Then
          Set objRange = objRange.SpecialCells(xlCellTypeConstants, xlNumbers)
          ''' Add a row at each 0
          objRange.EntireRow.Insert
        End If
        
        ''' Delete added Column
        Call objRange.Columns(1).EntireColumn.Delete

        ''' Remove an instance
        Set objRange = Nothing

        ''' Exit the Sub
        Exit Sub
         
      ''' Define the subfunction for errorhandling.
      ErrHandler:
        ''' Error.
        '''Call gobjLogFile.Error("ThisWorkbook, function :
      InsertRowAtEachChange", _
                               "Description goes here", Err.Number,
      Err.Description)
        
        ''' Resume anyway.
        Resume Next

      End Sub         
      Last Updated ( Friday, 22 February 2008 )

[ 本帖最后由 marko1981 于 2010-7-1 06:19 编辑 ]

aidixiao

不错的资料，谢谢楼主。