ホーム > ライブラリ > Range > fRange_Value, fRange_Formula, fRange_Text

ライブラリ

fRange_Value, fRange_Formula, fRange_Text

************************************************************************
セルの値を配列で返します
※「fRange_Value」は .Value、
   「fRange_Formula」は .Formula、
   「fRange_Text」は .Text 
 の結果を返します。

【引数】SliceDirection:xlRow or xlColumn を指定すると、
                                  1行 or 1列 のデータを1次元配列で返します。

【重要】配列の要素番号は、行・列番号に合わせて返します。
            そして、行・列をEnumで定義することで、非常に開発しやすくなります。
    ※シート上のセルも、配列の値も、同じ Enum で処理できるのがいいんです!

    Enumで定義する事で、行or列の削除・追加・入替があっても、
          基本的には対象となるEnumのメンバーを削除・追加・入替すればOKなので、
            メンテナンスが超簡単になります!
            ※直接 [Range("A1")] や [Cells(1,2)] 等と書くのはメンテ大変です。。。

            下記のEnumの例で、データ開始行・終了行等を定義しているのは、
            For文等に使う為です(データの開始から終了まで処理する等)
            ※開始、終了の概念でコーディングできるので、可読性UP+メンテUP

    とにかく、1度使えばやみつきになるハズ!!
            ※配列に格納した後で、1行だけ抜き出したいって時には、
               fArray_Slice って関数が便利なので、ライブラリを参照ください~

【例】Enumの個人的な設定例を参考までに掲載しておきます
Enum E_Row_Menu
    Data_S=2                                'データ開始行
        Data1 = E_Row_Menu.Data_S
        Data2
        Data3
    Data_E = E_Row_Menu.Data3   'データ終了行
End Enum
Enum E_Col_Menu
    Data_S=3                                'データ開始列
        フォルダパス = E_Col_Menu.Data_S
        ファイル名
        拡張子
    Data_E = E_Col_Menu.拡張子    'データ終了列
End Enum
************************************************************************

Public Function fRange_Value(Range As Range, Optional SliceDirection As XlRowCol = 0) As Variant
    
    fRange_Value = prRange_Data(Range, SliceDirection)
    
End Function

Public Function fRange_Formula(Range As Range, Optional SliceDirection As XlRowCol = 0) As Variant
    
    fRange_Formula = prRange_Data(Range, SliceDirection, GetFormula:=True)
    
End Function

Public Function fRange_Text(Range As Range, Optional SliceDirection As XlRowCol = 0) As Variant
    
    fRange_Text = prRange_Data(Range, SliceDirection, GetText:=True)
    
End Function

Private Function prRange_Data(Range As Range, Optional SliceDirection As XlRowCol = 0, _
                              Optional GetFormula As Boolean, Optional GetText As Boolean) As Variant
    
    '複数エリアの場合は、対象外なので終了
    If Range Is Nothing Then Exit Function
    If Range.Areas.Count <> 1 Then Exit Function
    
    'セルの値を配列に格納
    Dim DataAry As Variant
    DataAry = prRange_GetData(Range, GetFormula, GetText)
    If IsArray(DataAry) = False Then Exit Function
    
    '該当レンジの行・列の情報を取得
    Dim Row_S       As Long
    Dim Col_S       As Long
    With Range
        Row_S = .Row
        Col_S = .Column
    End With
    
    '行・列要素を取得
    Dim Row_L   As Long, Row_U  As Long
    Dim Col_L   As Long, Col_U  As Long
    Row_L = LBound(DataAry, 1): Row_U = UBound(DataAry, 1)
    Col_L = LBound(DataAry, 2): Col_U = UBound(DataAry, 2)
    
    Dim Cnt_Row     As Long
    Dim Cnt_Col     As Long
    Cnt_Row = Row_U - Row_L + 1
    Cnt_Col = Col_U - Col_L + 1
    
    Dim RetAry      As Variant
    Dim Row_T       As Long
    Dim Col_T       As Long
    
    Select Case SliceDirection
    
    '行方向に切り取る場合
    Case XlRowCol.xlRows
        '格納配列を、列番号に合わせて調整
        ReDim RetAry(Col_S To Col_S + Cnt_Col - 1)
        
        '値を格納配列に格納していく
        Row_T = Row_L
        For Col_T = Col_L To Col_U
            RetAry(Col_S + Col_T - Col_L) = DataAry(Row_T, Col_T)
        Next
        
        
    '列方向に切り取る場合
    Case XlRowCol.xlColumns
        '格納配列を、行番号に合わせて調整
        ReDim RetAry(Row_S To Row_S + Cnt_Row - 1)
        
        '値を格納配列に格納していく
        Col_T = Col_L
        For Row_T = Row_L To Row_U
            RetAry(Row_S + Row_T - Row_L) = DataAry(Row_T, Col_T)
        Next
    
    '行・列の要素番号で返す場合
    Case Else
        
        '格納配列を、行・列番号に合わせて調整
        ReDim RetAry(Row_S To Row_S + Cnt_Row - 1, Col_S To Col_S + Cnt_Col - 1)
        
        '値を格納配列に格納していく
        For Col_T = Col_L To Col_U
            For Row_T = Row_L To Row_U
                RetAry(Row_S + Row_T - Row_L, Col_S + Col_T - Col_L) = DataAry(Row_T, Col_T)
            Next
        Next
        
    End Select
    
    DataAry = Empty
    prRange_Data = RetAry
    
End Function

Private Function prRange_GetData(Range As Range, GetFormula As Boolean, GetText As Boolean)
    
    If Range Is Nothing Then Exit Function
    
    Dim DataAry As Variant
    
    With Range
        
        'レンジの値を配列に一旦格納
        '1セルの場合、配列を調整して格納
        If .Rows.Count = 1 And .Columns.Count = 1 Then
            ReDim DataAry(1 To 1, 1 To 1)
            Select Case True
            Case GetText:       DataAry(1, 1) = .Text
            Case GetFormula:    DataAry(1, 1) = .Formula
            Case Else:          DataAry(1, 1) = .Value
            End Select
        Else
            Select Case True
            Case GetText:       DataAry = prRange_Text(.Cells)
            Case GetFormula:    DataAry = .Formula
            Case Else:          DataAry = .Value
            End Select
        End If
        
    End With
    
    prRange_GetData = DataAry
    
End Function

Private Function prRange_Text(Range As Range) As Variant
    
    With Range
        
        Dim Cnt_Row     As Long
        Dim Cnt_Col     As Long
        Cnt_Row = .Rows.Count
        Cnt_Col = .Columns.Count
        
        Dim RetAry      As Variant
        ReDim RetAry(1 To Cnt_Row, 1 To Cnt_Col)
        
        Dim i   As Long
        For i = 1 To Cnt_Row
            Dim j   As Long
            For j = 1 To Cnt_Col
                RetAry(i, j) = .Cells(i, j).Text
            Next
        Next
        
    End With
    
    prRange_Text = RetAry
    
End Function

Range   2017/06/19   shono
 |  Diff ≫

この記事へのコメント

コメントを送る

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