ライブラリ

fRange_EndRow

***************************************************************
指定Rangeのデータ最終行を取得

【引数】Range :レンジ
              Hidden : 非表示行に対応するオプション
              MergeCell: 結合セルに対応するオプション
***************************************************************


Public Function fRange_EndRow(Range As Range, Optional Hidden As Boolean = True, Optional MergeCell As Boolean = True, _
                              Optional EndEdge As Long = 0) As Long
    
    If Range Is Nothing Then Exit Function
    
    With Range.Worksheet
        
        '認識されてる最終行を取得
        Dim Row_Used    As Long
        Row_Used = .UsedRange.Row + .UsedRange.Rows.Count - 1
        
        'EndUp用の行位置を取得
        Dim Row_Edge    As Long
        Row_Edge = EndEdge
        If Row_Edge <= 0 Then
            Row_Edge = Row_Used
        End If
        
        '対象エリアを絞り込む
        Dim Area    As Range
        Set Area = Range.Application.Intersect(Range.EntireColumn, .UsedRange.EntireRow)
        
        '開始・終了列を取得
        Dim Col_S   As Long
        Dim Col_E   As Long
        Col_S = Area.Column
        Col_E = Area.Column + Area.Columns.Count - 1
        
        Dim Col_T   As Long
        For Col_T = Col_S To Col_E
            
            '所定位置からEndUpで最終行を取得
            Dim Row_End As Long
            If IsEmpty(.Cells(Row_Edge, Col_T)) = False Then
                Row_End = Row_Edge
            Else
                Row_End = .Cells(Row_Edge, Col_T).End(xlUp).Row
            End If
            
            '非表示セルも検索する場合
            If Hidden = True Then
                If Row_End < Row_Edge Then
                    
                    'データを配列に格納
                    Dim DataAry As Variant
                    DataAry = .Range(.Cells(Row_End, Col_T), .Cells(Row_Edge, Col_T)).Value
                    
                    '値のある最終位置を取得
                    Dim i   As Long
                    For i = UBound(DataAry, 1) To LBound(DataAry, 1) Step -1
                        If CStr(DataAry(i, 1)) <> "" Then
                            Row_End = Row_End + i - 1
                            Exit For
                        End If
                    Next
                    
                End If
            End If
            
            '結合セルに対応
            If MergeCell = True Then
                Dim Cell    As Range
                Set Cell = .Cells(Row_End, Col_T)
                If Cell.MergeCells = True Then
                    Row_End = Row_End + Cell.MergeArea.Rows.Count - 1
                End If
            End If
            
            '最大位置を取得
            Dim Row_Max As Long
            If Row_Max < Row_End Then
                Row_Max = Row_End
            End If
            
        Next
        
    End With
    
    fRange_EndRow = Row_Max
    
End Function

Range   2018/06/30   shono

この記事へのコメント

コメントを送る

 
※ メールは公開されません
Loading...
 画像の文字を入力してください