ドント式で議席数の計算をしてくれるExcel関数

まえがき

 比例代表制で議席数を決める際の計算式の一つに「ドント式」と呼ばれる計算方法があります.このドント式は日本をはじめ,多くの選挙で用いられているものですが,Excelなどの表計算ソフトで計算しようと思うと,なかなか骨が折れるものです.
 そこで今回,ドント式で議席数の計算をしてくれるExcel関数を自作しました.お役に立てば幸いです.

使い方&コード

 使い方は以下の通りです.

1.Excel VBAの起動とコードの入力

 「Alt」キーと「F11」キーを同時に押し,Excel VBA(Visual Basic)を起動させます.

ほぼ真っ白な画面

 こういう画面が出てくると成功です.
 上の「挿入」から「標準モジュール」を選択します.

これです.


 そうしたうえで,真ん中の入力スペースに,以下のコードをそのまま貼り付けます.

'【注意】
'このコードに関する一切の権利は,作成者である@sywhiflr21(Twitter)に帰属します.
'このコードの利用は,すべて自己責任で行ってください.
'作成者は,このコードの利用に関して発生したいかなる損害に関しても責任を負わないものとします.
'このコードを無断で複製し,頒布し,公開し,または商用利用することを禁じます.
'このコードの改造は,私的な使用に供する場合についてのみ認めます.
'この【注意】の文言の一部または全部を許可なく改変してはいけません(コードを改造する場合を含む).

Function Dhondt(Votes As Range, RangeVotes As Range, CellSeats)

'Rowは行,Columnは列

If Votes.Rows.Count >= 2 Or Votes.Columns.Count >= 2 Then
    MsgBox "Error!"
End If

If Votes.Rows.Count >= 2 Or Votes.Columns.Count >= 2 Then End

Dim Seats As Integer
Seats = CellSeats


If RangeVotes.Rows.Count >= 2 And RangeVotes.Columns.Count >= 2 Then
    MsgBox "Error!"
End If

If RangeVotes.Rows.Count >= 2 And RangeVotes.Columns.Count >= 2 Then End


Dim VorH As Integer
'横長(列(C)が変わる)なら1,縦長(行(R)が変わる)なら2

If RangeVotes.Rows.Count >= 2 Then
    VorH = 2
End If

If RangeVotes.Columns.Count >= 2 Then
    VorH = 1
End If
    
Dim PartyVotes() As Single
Dim CurrentVotes() As Single
Dim PartySeats() As Single

ReDim PartyVotes(RangeVotes.Count - 1)
ReDim CurrentVotes(RangeVotes.Count - 1)
ReDim PartySeats(RangeVotes.Count - 1)



R = RangeVotes.Row
C = RangeVotes.Column
N = RangeVotes.Count

If VorH = 1 Then
    Dim i As Integer
    For i = 1 To N
    PartyVotes(i - 1) = Cells(R, C + i - 1)
    CurrentVotes(i - 1) = PartyVotes(i - 1)
Next i
End If

If VorH = 2 Then
    For i = 1 To N
    PartyVotes(i - 1) = Cells(R + i - 1, C)
    CurrentVotes(i - 1) = PartyVotes(i - 1)
Next i
End If

For i = 1 To N
    PartySeats(i - 1) = 0
Next i

Dim CurrentSeats As Integer
CurrentSeats = 0
Do
    For i = 1 To N

        If Application.WorksheetFunction.Max(CurrentVotes) = CurrentVotes(i - 1) Then
            PartySeats(i - 1) = PartySeats(i - 1) + 1
            Div = PartySeats(i - 1) + 1
            CurrentVotes(i - 1) = PartyVotes(i - 1) / Div
            CurrentSeats = CurrentSeats + 1
        End If
        If CurrentSeats = Seats Then Exit For
    Next i
    If CurrentSeats = Seats Then Exit Do
Loop

If VorH = 1 Then
    Dhondt = PartySeats(Votes.Column - C)
End If

If VorH = 2 Then
    Dhondt = PartySeats(Votes.Row - R)
End If

End Function


コードについているの色が写真と違うこともあるかと思いますが,
動作には全く影響しないので気にしないでください.

2.関数の使い方

 あとはシンプルです.
 Excel VBAを閉じてExcelの通常の画面に戻り,セルに

=Dhondt(その党の得票数のセル,すべての党の議席のセル範囲,総議席数)

を入力すれば,自動で計算してくれます.


この場合,総議席数は20と設定

 ここでは総議席数は直接入力しましたが,総議席数が入力されているセルを指定しても構いません.

 また,縦表示にも対応しています.

3.注意

  • 保存するときは「Excel マクロ有効ブック」(拡張子が.xlsmとなるファイル)として保存してください.

  • コードそのものにも書いていますが,このコードに関する一切の責任は負いかねますのでご了承ください.また,無断での複製・公開・頒布・商用利用を禁じます.常識の範囲でお使いください(改造は,私的利用にとどめる場合のみ認めます).

  • 現実にはほぼ起こりえませんが,得票数が同数の場合は,より左(または上)にある政党に優先して議席が配分されます.

あとがき

 このコードが役に立ったと思われる方は,ぜひ「スキ」を押していただけると幸いです.また,SNS上などでの宣伝も歓迎します.
 ご意見・ご要望・ご感想などは,Twitter上で私(@sywhiflr21)あてにメッセージをお送りください(Noteでコメントしていただいてもいいのですが,Twitterでお送りいただけるほうがより確実に届くと思います).お褒めの言葉などもいただけると大変喜びます.


この記事が気に入ったらサポートをしてみませんか?