関数を作る_2（VBA研究会議事録_13）

VBA研究会で論じられた内容を記録する議事録の13本目（2023/04/15開催分）です。前回の議事録はコチラになります。

hirocom777.hatenadiary.org

前回はから新しい企画に取り組んでいます。Office365などに搭載されていて、それより前のExcelに搭載されていないワークシート関数を作ってみようというものです。前回は基本となるファンクションプロシージャを作りました。

今回は、このファンクションプロシージャに機能を追加してみようと思います。

機能を追加する

前回までのコードを再掲します。

Private Function exp1(ByVal tarRng As Range, _
                        Optional ByVal minValue As Variant, _
                        Optional ByVal maxValue As Variant, _
                        Optional ByVal checkType As Long = 0) As Variant

    Dim dic As New Dictionary
    
    Dim rng As Range
    For Each rng In tarRng
        Do
            '数値以外は処理しない
            If Not IsNumeric(rng.Value) Then Exit Do

            '最小値以上（より大きい）か確認
            If Not IsMissing(minValue) Then
                If rng.Value < minValue Then Exit Do
                If (checkType And 1) And rng.Value = minValue Then Exit Do
            End If

            '最大値以下（より小さい）か確認
            If Not IsMissing(maxValue) Then
                If rng.Value > maxValue Then Exit Do
                If (checkType And 2) And rng.Value = maxValue Then Exit Do
            End If

            '重複していない値を登録
            If Not dic.Exists(rng.Value) Then
                dic.Add rng.Value, Null
            End If
         Loop While False
    Next rng
        
    exp1 = dic.Keys

End Function

今回は、このプロシージャに配列形式を選択する機能を追加します。

配列をソートする

まず、読み込んだ配列をソートする機能をつけてみたいと思います。配列とソート方向を指定するとソートした配列を返すファンクションプロシージャを作りました。

'バブルソートを使った配列のソート
Private Function SortArray(ByVal sortValue As Variant, sortType As Long) As Variant
    Do
      Dim i As Long
      Dim IsCompleat As Boolean: IsCompleat = True
      For i = 0 To UBound(sortValue) - 1

        '指定によりソート方向を選択
        If (sortType = xlAscending And sortValue(i) > sortValue(i + 1)) Or _
           (sortType = xlDescending And sortValue(i) < sortValue(i + 1)) Then

          '隣り合う配列を入れ替え
          Dim dataBuf As Variant
          dataBuf = sortValue(i)
          sortValue(i) = sortValue(i + 1)
          sortValue(i + 1) = dataBuf
          IsCompleat = False
        End If
      Next i

    '入れ替えがなくなったら終了
    Loop Until IsCompleat
    SortArray = sortValue
End Function

バブルソートを使用して配列をソートしています。バブルソートは隣り合う値をソート方向に入れ替えを、入れ替えが無くなるまで続けます。ソート方向の指定は、定数のxlAscending（1:昇順）/xlDescending（2:降順）で指定します。Sortメソッドなどでソート方向を指定する際に使用される定数です。この方法だとコードがわかりやすくなりますね。

2次元配列にする

取得した配列は1次元の配列です。n行1列/1行n列の2次元配列に変換する機能をつけましょう。こちらもファンクションプロシージャを作成しました。

'2次元配列に変換
Private Function To2Dtransformation(ByVal tarArr As Variant, arrType As Long) As Variant
  Select Case arrType

  Case xlRows 'n行1列に変換
    To2Dtransformation = WorksheetFunction.Transpose(tarArr)

  Case xlColumns '1行n列に変換
    ReDim tmpArr(0, 0 To UBound(tarArr))
    Dim i As Long
    For i = LBound(tarArr) To UBound(tarArr)
      tmpArr(0, i) = tarArr(i)
    Next i
    To2Dtransformation = tmpArr
  Case Else
    To2Dtransformation = tarArr
  End Select
End Function

n行1列の配列に変換するには、ワークシート関数のTransposeを使用できます。でも、1行n列には変換できないんですね。ですので、動的配列を使って変換しています。変換方向の指定も定数を用います。xlRows（1:行指定）/xlColumns（2:列指定）とすると判りりやすいですね。

実装方法

この2つのファンクションプロシージャを、実装して「exp2」としてみました。

'sortType 判定方法   0-ソートしない（デフォルト）
'　                 1-昇順（xlAscending）
'　                 2-降順（xlDescending）
'transferType 判定方法   0-変換しない（デフォルト）
'　                     1-行指定（xlRows）
'　                     2-列指定（xlColumns）
Private Function exp2(ByVal tarRng As Range, _
                        Optional ByVal minValue As Variant, _
                        Optional ByVal maxValue As Variant, _
                        Optional ByVal checkType As Long = 0, _
                        Optional ByVal sortType As Long = 0, _
                        Optional ByVal transferType As Long = 0) As Variant

'この部分はexp1と同じ
    
    exp2 = dic.Keys
    '配列のソート
    If sortType <> 0 Then exp2 = SortArray(exp2, sortType)
    '2次元配列に変換
    If transferType <> 0 Then exp2 = To2Dtransformation(exp2, transferType)
End Function

この様になりました。ソート方向、2次元の変換方法の指定は、各ファンクションプロシージャと同じです。