はじめてのユーザー定義関数 〜 合計を 100% に調整

このページでは、ワークシートで利用できるユーザー定義関数を Excel VBA を使って作成する手順をご紹介します。
なお、ここでは数10件程度のデータ数を想定しています。データ数が多かったり、このユーザー定義関数を多用すると長い処理時間がかかるので注意してください。

今、ワークシートに以下のような表があります。合計から各区分の構成比を計算し、それを ROUND 関数を使って小数点以下2桁(1%単位)に四捨五入しています。四捨五入した後の構成比の合計は当然 100%になるとは限りません。しかし、比率を基に残りなく配分したい場合等、合計を一定の数値やぴったり100%にしたいときがあります。この調整をマクロを使って自動的に行ってみましょう。


Visual Basic Editorを起動します。


アクティブブックのプロジェクトに標準モジュールを挿入します。ユーザー定義ワークシート関数は標準モジュールに作成する必要があります。


標準モジュール Module1 が挿入され、コードのウィンドウが開きます。



このコードのウィンドウにユーザー定義関数を作成します。
ブラウザ上で、以下のマクロをマウスで範囲選択してコピーし、コードのウィンドウに貼り付けてください。少し長いですが、Function Haibun( … の行から End Function までです。

Function Haibun(真値 As Variant, 表示値 As Variant, 目標合計値 As Double, 単位 As Double) As Variant
    Dim a() As Double  '真値
    Dim b() As Double  '表示値
    Dim c() As Double  '表示値-真値
    Dim x() As Long    '配列インデックス
    Dim u   As Double  '数値の単位
    Dim s   As Double  '表示値の合計
    Dim n   As Long    'データ個数
    Dim z   As Double  '目標合計値との差
    Dim i As Long, j As Long, k As Long, m As Long, o As Long, p As Long
    Dim r As Range

    On Error GoTo ErrorHandler
    Haibun = CVErr(xlErrValue)

    u = 単位

    If IsObject(真値) Then
        Set r = 真値.Areas(1).Cells
        n = r.Count
        ReDim a(1 To n), b(1 To n, 1 To 1), c(1 To n), x(1 To n)
        For i = 1 To n
            a(i) = r(i).Value
        Next
    ElseIf IsArray(真値) Then
        n = UBound(真値) - LBound(真値) + 1
        ReDim a(1 To n), b(1 To n, 1 To 1), c(1 To n), x(1 To n)
        i = 1
        For j = LBound(真値) To UBound(真値)
            a(i) = 真値(j, 1)
            i = i + 1
        Next
    Else
        n = 1
        ReDim a(1 To n), b(1 To n, 1 To 1), c(1 To n), x(1 To n)
        a(1) = 真値
    End If

    If IsObject(表示値) Then
        Set r = 表示値.Areas(1).Cells
        If n <> r.Count Then Exit Function
        For i = 1 To n
            b(i, 1) = r(i).Value
            c(i) = b(i, 1) - a(i)
            x(i) = i
            s = s + b(i, 1)
        Next
    ElseIf IsArray(表示値) Then
        If n <> UBound(表示値) - LBound(表示値) + 1 Then Exit Function
        i = 1
        For j = LBound(表示値) To UBound(表示値)
            b(i, 1) = 表示値(j, 1)
            c(i) = b(i, 1) - a(i)
            x(i) = i
            s = s + b(i, 1)
            i = i + 1
        Next
    Else
        If n <> 1 Then Exit Function
        Haibun = 目標合計値
        Exit Function
    End If
    
    z = 目標合計値 - s
    If Abs(z) < u * 0.01 Then
        Haibun = b
        Exit Function
    End If

    'Sort
    For i = 1 To n - 1
        m = i
        For j = i + 1 To n
            If c(x(j)) < c(x(m)) Then m = j
        Next
        k = x(i): x(i) = x(m): x(m) = k
    Next

    i = 1
    j = Abs(CLng(z / u))
    k = Sgn(z)
    o = -1
    Do While j > 0
        If k > 0 Then p = i Else p = n - i + 1
        m = CLng(b(x(p), 1) / u) + k
        If m > 0 Then
            b(x(p), 1) = m * u
            j = j - 1
        End If
        i = i + 1
        If i > n Then
            If j = o Then
                Haibun = CVErr(xlErrNA)
                Exit Function
            End If
            o = j
            i = 1
        End If
    Loop

    Haibun = b
    
    Exit Function

ErrorHandler:
    Exit Function

End Function

これで標準モジュール Module1 に Haibun というユーザー定義関数が作成されました。



それではこのユーザー定義関数を使って実際に計算してみましょう。
エクセルのウィンドウに戻り、構成比の右の列 D2:D4 を選択します。ここに以下の式を入力します。
=Haibun(B2:B4/B5,ROUND(B2:B4/B5,2),100%,1%)

第1引数の「真値」には四捨五入する前の元のデータを指定します。この式では数量(B2:B4)を合計(B5)で割ったものを指定しています。どこか別の列で計算しておいて、そのセル範囲を指定しても構いません。

第2引数の「表示値」には四捨五入したデータを指定します。この式では数量(B2:B4)を合計(B5)で割り、ROUND関数で小数点以下2桁に四捨五入したものを指定しています。同じ計算をC列で行っているので、構成比のセル範囲(C2:C4)を指定しても構いません。

第3引数には[目標合計値]を指定します。第4引数には調整する数値の[単位]を指定します。1%の単位で調整するので、1% または 0.01 を指定します。

今回、作成したHaibun というユーザー定義関数は計算結果を配列で返すので、式は配列数式として入力します。D2:D4のセル範囲を選択し、式を入力したら Enter キーではなく、Ctrl キーと Shift キーを押しながら Enter キーを押して確定します。数式は自動的に { } で囲まれます。(式の両端の { } は自動的に付きます。文字として入力しないでください)



比率の合計が100%になるように調整されました。



このユーザー定義関数は基本的には作成したブックの中で有効です。(他のブックでも使用できますが、複数のブックで利用する場合は、「アドイン」を作成してそこに入れておく方が便利です)

ユーザー定義関数を削除するには、Visual Basic Editor でモジュールの中のコードを削除します。計算結果を残しておくには、削除する前に、セル範囲をコピー、形式を選択して貼り付けで[値]として貼り付けます。

マクロをすべて削除するには Visual Basic Editor の [プロジェクト] ウィンドウで削除したいモジュールを選択し、[ファイル]-[(モジュール)の解放](Excel 97 の場合は [(モジュール)の削除])を実行します。エクスポートの問い合わせがあるので、モジュールを別ファイルに保存しておきたい場合は [はい]、特に必要がなければ [いいえ] を選択します。(シートや ThisWorkbook のモジュールの場合は、モジュールは削除できないので、中のコードをすべて削除します)

※このユーザー定義関数では、調整するために追加する必要がある場合には丸めの前と後の差が小さいデータから順番に加算し、減少させる必要がある場合には差が大きいデータから順番に減算する方法で調整しています。例えば、数値を整数に四捨五入する場合、1. 7 と 90.8 のどちらか一方から 1 を引く必要があるときには、四捨五入の前後の差が大きい 1.7 から1を引きます。(四捨五入して2となり、そこから1を引いて1になります) ただし、引いた結果が0になるデータからは引きません。


戻る