ホーム > ライブラリ > Range > fRange_EndCol

ライブラリ

fRange_EndCol

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

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

Public Function fRange_EndCol(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 Col_ToLeft As Long
        Col_ToLeft = .Columns.Count
        
        Dim Col_Used    As Long
        Col_Used = .UsedRange.Column + .UsedRange.Columns.Count - 1
        
        '各行で
        Dim Rng_Row As Range
        Set Rng_Row = Application.Intersect(Range.EntireRow, .UsedRange.EntireColumn)
        
        Dim Row_S   As Long
        Dim Row_E   As Long
        Row_S = Rng_Row.Row
        Row_E = Rng_Row.Row + Rng_Row.Rows.Count - 1
        
        Dim Row_T   As Long
        For Row_T = Row_S To Row_E
            
            '所定位置から最終位置を取得
            Dim Col_End As Long
            Col_End = .Cells(Row_T, Col_ToLeft).End(xlToLeft).Column
            
            '非表示セルも検索する場合
            If Hidden = True Then
                
                '使用範囲と差があるなら
                If Col_End < Col_Used Then
                    
                    '配列用に調整(1セルにならないよう)
                    If Col_End + 1 = Col_Used Then
                        Col_Used = Col_Used + 1
                    End If
                    
                    'データを配列に格納
                    Dim DataAry As Variant
                    DataAry = .Range(.Cells(Row_T, Col_End + 1), .Cells(Row_T, Col_Used)).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
                            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
    
    Set Rng_Row = Nothing
    
End Function

Range   2018/06/30   shono

この記事へのコメント

コメントを送る

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