ドント式で議席数の計算をしてくれる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の通常の画面に戻り,セルに
を入力すれば,自動で計算してくれます.
ここでは総議席数は直接入力しましたが,総議席数が入力されているセルを指定しても構いません.
また,縦表示にも対応しています.
3.注意
保存するときは「Excel マクロ有効ブック」(拡張子が.xlsmとなるファイル)として保存してください.
コードそのものにも書いていますが,このコードに関する一切の責任は負いかねますのでご了承ください.また,無断での複製・公開・頒布・商用利用を禁じます.常識の範囲でお使いください(改造は,私的利用にとどめる場合のみ認めます).
現実にはほぼ起こりえませんが,得票数が同数の場合は,より左(または上)にある政党に優先して議席が配分されます.
あとがき
このコードが役に立ったと思われる方は,ぜひ「スキ」を押していただけると幸いです.また,SNS上などでの宣伝も歓迎します.
ご意見・ご要望・ご感想などは,Twitter上で私(@sywhiflr21)あてにメッセージをお送りください(Noteでコメントしていただいてもいいのですが,Twitterでお送りいただけるほうがより確実に届くと思います).お褒めの言葉などもいただけると大変喜びます.