Excel VBAでふるさと納税の返礼品の価値を最大化してみよう！

はじめに

こんにちは、バタフライ・栗田です。

唐突ですが、みなさんはふるさと納税をやっていますでしょうか。

ふるさと納税は、地方自治体への寄付を通じて、その地域の発展に貢献する制度です。寄付者には、その地域の特産品などの返礼品が贈られます。

ご存知の方も多いと思いますが、収入や家族構成により、おおよそ寄附金額の目安が決まっています。

そのような上限がある中で、数々の返礼品の中から、価値の高いものを選ぶのは、意外と難しいものです。

このブログ記事では、Excel VBAを活用して、ふるさと納税の返礼品の中から、最大の価値を持つものを見つけ出す方法について紹介します。

前準備

まず、"ふるさと納税還元率ランキングベスト300"のようなサイトで適当にいいなーと思う返礼品の寄付金額と市場価値をスプレッドシートにまとめます。

こんな感じで商品と寄付金額、還元率が載っています。

このサイトを元に寄附金額 x 還元率を市場価値として以下のようなスプレッドシートを作成してみました。

今回は20個までとしました。

VBAで返礼品の価値を最大化する

上の表を見ればわかる通り、返礼品の値段は様々です。

今回は２０個のリストですが、それだけでも選び方は100万通り以上あります。

各商品について選ぶ・選ばないの２通りあるので、２の２０乗。1,048,576通りとなります。

つまり、価値を最大化する最適解を選ぶのは、人力では非常に難しいことがわかります。

非常に多い計算に思えます。しかし、VBAのようなプログラムを使えば高速で終わらせることができます。

このようなケースでは競技プログラマーの間で"bit全探索"と呼ばれる手法を用いることで解決できます。それぞれの商品に対して、選ぶ選ばないを全通り試すという泥臭い方法で最適解を見つけることができます。

ソースコード

先ほどの商品目録を"item"、結果を表示させるシートを"result"とします。

適当にこのようなシートを作りました。寄付金額の上限を入力して最適な組み合わせを表示させる感じです。

```vba

Sub furusatoTaxValueMax()

    ' worksheetをセット

    Dim wsItem As Worksheet

    Set wsItem = Worksheets("item")

    Dim wsResult As Worksheet

    Set wsResult = Worksheets("result")

    ' 寄附金上限

    Dim limit As Long

    limit = wsResult.Cells(2, 2).Value

    ' ループ用変数

    Dim i As Long

    Dim j As Long

    ' 商品を配列に入れる

    Dim gifts As Variant

    Dim endRow As Long

    Dim n As Long

    With wsItem

        endRow = .Cells(Rows.Count, 1).End(xlUp).Row

        n = endRow - 1

        Dim no As Long

        Dim itemName As String

        Dim price As Long

        Dim marketValue As Long

        ReDim gifts(0 To n - 1, 0 To 3)

        For i = 2 To endRow

            no = .Cells(i, 1).Value

            itemName = .Cells(i, 2).Value

            price = .Cells(i, 3).Value

            marketValue = .Cells(i, 5).Value

            gifts(i - 2, 0) = no

            gifts(i - 2, 1) = itemName

            gifts(i - 2, 2) = price

            gifts(i - 2, 3) = marketValue

        Next i

    End With

    ' 答えとなる数値

    Dim bestIndex As Long

    bestIndex = 0

    ' 価値と寄附金額

    Dim totalValue As Long

    Dim totalPrice As Long

    ' 価値の最大値の保存用

    Dim maxValue As Long

    maxValue = 0

    ' bit全探索を始める

    For i = 0 To 2 ^ n - 1

        totalValue = 0

        totalPrice = 0

        ' 例えば10は二進数であらわすとと1010となる

        ' そこで, 10 And 2^jとすることでbitが立っているか調べる

        For j = 0 To n - 1

            If i And 2 ^ j Then

                ' bitが立っている場合、totalに加える

                totalValue = totalValue + gifts(j, 3)

                totalPrice = totalPrice + gifts(j, 2)

            End If

        Next j

        ' 寄附金の合計が制限金額以内且つ、価値が最大化されていたら

        If totalPrice <= limit And totalValue >= maxValue Then

            ' 更新する

            maxValue = totalValue

            bestIndex = i

        End If

    Next i

    ' 結果を書き出す

    ' 書き始めの行番

    Dim k As Long

    k = 7

    With wsResult

        .Cells(4, 2).Value = maxValue

        For j = 0 To n - 1

            If bestIndex And 2 ^ j Then

                .Cells(k, 2).Value = gifts(j, 0)

                .Cells(k, 3).Value = gifts(j, 1)

                .Cells(k, 4).Value = gifts(j, 2)

                .Cells(k, 5).Value = gifts(j, 3)

                k = k + 1

            End If

        Next j

    End With

End Sub

```

実行してみました。ちょうど75,000円使い切って、73,051円の価値を取得できたことが分かります。

終わりに

このようにプログラムを用いて、人間の頭では非常に時間がかかるような計算も高速に計算することができました。

今回はふるさと納税を題材にしましたが、業務でも、上限内での最適な組み合わせを考えるようなシーンが多くあるかと思います。

私は業務で使用するマクロを日常的に書いています。競技プログラマーとして、日々複雑な問題を解いているため、堅牢且つ高速動作するプログラムを書くことができます。

最後に宣伝となりますが、そんな私のVBAプログラム、効率化ファイルを最低3,000円という価格で納品します。ぜひご気軽に相談をしてください。

おまけ

今回紹介したbit全探索というテクニックは非常に強力でありながら、アイテム数が多くなると計算量的に厳しくなるという欠点があります。今回は要素数が20だったので、最大で2,000万回程度の計算量（2の20乗 x 20）で済みました。しかし要素数が30になるとどうでしょうか。なんと計算量は300億回を超えてしまいます。これは現代の一般的なコンピューターではかなり絶望的な計算量です。しかし、より高度なアルゴリズムを使えば、効率的に計算をすることが可能です。次回以降に紹介をしたいと思います。