ライブラリ

fRange_EndRow

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

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

Public Function fRange_EndRow(Range As Range, Optional Hidden As Boolean = True, Optional MergeCell As Boolean = True) As Long
    
    If Range Is Nothing Then Exit Function
    
    With Range.Worksheet
        
        '検索最終位置を調整(指定無ければ最終位置)
        Dim Row_Cnt As Long
        Row_Cnt = .Rows.Count
        
        Dim Row_Used    As Long
        Row_Used = .UsedRange.Row + .UsedRange.Rows.Count - 1
        
        '各列で
        Dim Rng_Col As Range
        Set Rng_Col = Application.Intersect(Range.EntireColumn, .UsedRange.EntireRow)
        
        Dim Col_S   As Long
        Dim Col_E   As Long
        Col_S = Rng_Col.Column
        Col_E = Rng_Col.Column + Rng_Col.Columns.Count - 1
        
        Dim Col_T   As Long
        For Col_T = Col_S To Col_E
            
            '所定位置からEndUpで最終行を取得
            Dim Row_End As Long
            Row_End = .Cells(Row_Cnt, Col_T).End(xlUp).Row
            
            '非表示セルも検索する場合
            If Hidden = True Then
                
                '使用範囲と差があるなら
                If Row_End < Row_Used Then
                    
                    '配列用に調整(1セルにならないよう)
                    If Row_End + 1 = Row_Used Then
                        Row_Used = Row_Used + 1
                    End If
                    
                    'データを配列に格納
                    Dim DataAry As Variant
                    DataAry = .Range(.Cells(Row_End + 1, Col_T), .Cells(Row_Used, 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
                            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
    
    Set Rng_Col = Nothing
    
End Function

Range   2018/06/30   shono

この記事へのコメント

コメントを送る

 
※ メールは公開されません
Loading...
 画像の文字を入力してください
10月 2019年11月 12月
     12
3456789
10111213141516
17181920212223
24252627282930

ブログ投稿者一覧

年別アーカイブ一覧