ライブラリ

fArray_Paste

***************************************************************
指定セルにデータ配列(主にfRange_Valueで取得した配列)を貼り付ける関数

【注意】非表示行があると正しくデータを貼り付けれない(Excelの既存バグ)

【引数】Cell:貼付けセル(1セルで十分。範囲の場合は最初のセルが起点となる)
            DataAry:貼付けるデータ配列
            Trans:貼付け時、配列の行・列を入れ替えるオプション
                       ※1次元配列の場合、2次元配列に変換し、縦方向に張り付ける
            PasteFormula:数式として貼り付けるオプション

【戻値】配列を張付けた範囲のRange
***************************************************************

Public Function fArray_Paste(Cell As Range, DataAry As Variant, Optional Trans As Boolean = False, _
                             Optional PasteFormula As Boolean = False) As Range
    
    '- 配列以外は終了
    If fArray_IsArray(DataAry) = False Then Exit Function
    
    Dim Row_Paste       As Long
    Dim Col_Paste       As Long
    
    Dim CntDim          As Long
    CntDim = fArray_DimCount(DataAry)
    Select Case CntDim
    Case 1
        Row_Paste = 1
        Col_Paste = UBound(DataAry, 1) - LBound(DataAry, 1) + 1
    
    Case 2
        Row_Paste = UBound(DataAry, 1) - LBound(DataAry, 1) + 1
        Col_Paste = UBound(DataAry, 2) - LBound(DataAry, 2) + 1
    
    Case Else
        Exit Function
        
    End Select
    
    '配列の貼付け
    If Trans = False Then
        Call prArray_Paste(Cell.Resize(Row_Paste, Col_Paste), DataAry, PasteFormula)
    
    '行・列を逆転
    Else
        
        '配列の行・列数を逆転
        Dim TempRC  As Long
        TempRC = Row_Paste
        Row_Paste = Col_Paste
        Col_Paste = TempRC
        
        '配列の行・列を逆転
        Dim PasteAry    As Variant
        PasteAry = fArray_Trans(DataAry)
        
        Call prArray_Paste(Cell.Resize(Row_Paste, Col_Paste), PasteAry, PasteFormula)
        
    End If
    
    Set fArray_Paste = Cell.Resize(Row_Paste, Col_Paste)
    
End Function

Private Function prArray_Paste(Range As Range, DataAry As Variant, PasteFormula As Boolean)
    
    If PasteFormula = False Then
        Range.Value = DataAry
    Else
        Range.Formula = DataAry
    End If
    
End Function

Array   2017/11/21   shono

この記事へのコメント

コメントを送る

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