ライブラリ

fRange_EndCol

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

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


Public Function fRange_EndCol(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 Col_Used    As Long
        Col_Used = .UsedRange.Column + .UsedRange.Columns.Count - 1
        
        'ToLeft用の列位置を取得
        Dim Col_Edge As Long
        Col_Edge = EndEdge
        If Col_Edge <= 0 Then
            Col_Edge = Col_Used
        End If
        
        '各行で
        Dim Area    As Range
        Set Area = Range.Application.Intersect(Range.EntireRow, .UsedRange.EntireColumn)
        
        Dim Row_S   As Long
        Dim Row_E   As Long
        Row_S = Area.Row
        Row_E = Area.Row + Area.Rows.Count - 1
        
        Dim Row_T   As Long
        For Row_T = Row_S To Row_E
            
            '所定位置から最終位置を取得
            Dim Col_End As Long
            If IsEmpty(.Cells(Row_T, Col_Edge)) = False Then
                Col_End = Col_Edge
            Else
                Col_End = .Cells(Row_T, Col_Edge).End(xlToLeft).Column
            End If
            
            '非表示セルも検索する場合
            If Hidden = True Then
                If Col_End < Col_Edge Then
                    
                    'データを配列に格納
                    Dim DataAry As Variant
                    DataAry = .Range(.Cells(Row_T, Col_End), .Cells(Row_T, Col_Edge)).Value
                    
                    '値のある最終位置を取得
                    Dim i   As Long
                    For i = UBound(DataAry, 2) To LBound(DataAry, 2) Step -1
                        If CStr(DataAry(1, i)) <> "" Then
                            Col_End = Col_End + i - 1
                            Exit For
                        End If
                    Next
                    
                End If
            End If
            
            '結合セルに対応
            If MergeCell = True Then
                Dim Cell    As Range
                Set Cell = .Cells(Row_T, Col_End)
                If Cell.MergeCells = True Then
                    Col_End = Col_End + Cell.MergeArea.Columns.Count - 1
                End If
            End If
            
            '最大位置を取得
            Dim Col_Max As Long
            If Col_Max < Col_End Then
                Col_Max = Col_End
            End If
            
        Next
        
    End With
    
    fRange_EndCol = Col_Max
    
End Function

Range   2018/06/30   shono

この記事へのコメント

コメントを送る

 
※ メールは公開されません
Loading...
 画像の文字を入力してください
9月 2020年10月 11月
    123
45678910
11121314151617
18192021222324
25262728293031

ブログ投稿者一覧

年別アーカイブ一覧