February 15, 2016

Excel VBAで数列を生成する

VBAでデータをプロットする際に、軸の情報として使用するために適当な数列を生成するユーザー定義関数を作成しました。

createArray: 数列の生成
repeatArray: 与えられた数列を繰り返した数列を生成
combineArray: 与えられた数列を繋げた数列を生成

createArray(1,5,TRUE,,,) = {1,2,3,4,5}
createArray(1,5,,TRUE,,3) = {1,2.5,5}


Function createArray(beginValue As Variant, Optional endValue As Variant, Optional IntervalMode As Boolean = True, Optional LengthMode As Boolean = False, Optional Param As Variant)
    Dim tempArray As Variant
    Dim Interval As Variant, Length As Variant
    
    If IsMissing(endValue) Then endValue = beginValue
    
    If IntervalMode Then
        If IsMissing(Param) Then Param = 1
        Interval = Param
        Length = WorksheetFunction.Floor((endValue - beginValue) / Interval, 1) + 1
    End If
    
    If LengthMode Then
        If IsMissing(Param) Then Param = WorksheetFunction.Floor(endValue - beginValue, 1)
        Length = Param
        Interval = (endValue - beginValue) / (Length - 1)
    End If
        
    ReDim tempArray(0 To Length - 1)
    
    For i = 0 To Length - 1
        tempArray(i) = beginValue + Interval * i
    Next

    createArray = tempArray
End Function

Function repeatArray(origArray As Variant, Iteration As Integer)
    Dim tempArray As Variant
    Dim Length As Long
    
    Length = UBound(origArray) - LBound(origArray) + 1
    If Iteration < 1 Then Iteration = 1
    ReDim tempArray(0 To Length * Iteration - 1)
    
    For i = 0 To Length * Iteration - 1
        tempArray(i) = origArray(i Mod Length)
    Next
    
    repeatArray = tempArray
End Function

Function combineArray(Array1 As Variant, Array2 As Variant)
    Dim tempArray As Variant
    Dim Length1 As Long, Length2 As Long
    
    Length1 = UBound(Array1) - LBound(Array1)
    Length2 = UBound(Array2) - LBound(Array2)
    ReDim tempArray(0 To Length1 + Length2 - 1)
    
    For i = 0 To Length1 - 1
        tempArray(i) = Array1(i)
    Next
    
    For i = Length1 To Length1 + Length2 - 1
        tempArray(i) = Array2(i - Length1)
    Next
    
    combineArray = tempArray
End Function

No comments :

Post a Comment