• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

D'Hondt sistemi için KTF yapılabilir mi?

Muhammet Okumuş

Muhammet Okumuş

Destek Ekibi
Destek Ekibi
Katılım
28 Eylül 2007
Mesajlar
4,042
Excel Vers. ve Dili
2013 Türkçe
Arkadaşlar merhaba,
Sistem
https://tr.wikipedia.org/wiki/D'Hondt_sistemi
burda anlatılmış. Yerleşik fonksiyonlarla sistemi yapabiliyorum. Peki bu hesaplamayı KTF ile yapabilir miyiz?
Değerlerin C4:F4 arasında kişi sayısının da 12 olduğunu varsayarsak şöyle KTF yazılabilir mi?
=DHONDT(C4;C4:F4;12)
 

Ekli dosyalar

Haluk Bey;
Verdiğiniz linkteki KTF'yi uyguladım. Fonksiyon bir şey hesaplıyor ama neyi, neye göre hesapladığını anlayamadım. Bu sistemde millet vekili sayısının hesaplanabilmesi için o bölgenin kaç mv çıkartacağı belirtmeli ama burda bu değer belirtilmemiş.
 
Doğrusu pek ilgilendiğim bir konu değil ama, 1. linkte @muygun 'un dosyası işinize yaramıyor mu?

.
 
Muhammet Okumuş' Alıntı:
Fonksiyon bir şey hesaplıyor ama neyi, neye göre hesapladığını anlayamadım.
Genişletmek için tıkla ...

Daha anlaşılır biçimde hazırlamaya çalıştım. Belki işinize yarar...

228051


C#: 
Option Explicit

Function D_Hondt(reySayilari As Range, vekilSayisi As Range) As Integer()
    ' Zeki Gürsoy © 01.06.2021
    ' gursoyzeki@gmail.com
    ' https://zekigursoy.blogspot.com
    '
    Dim reyCount As Integer, reyMax As Double, reyPos As Integer, kalanVekilSayisi As Integer, dividerCount As Integer, rng As Range
    Dim reyArray() As Long, vekilArray() As Integer, vekilArray2() As Integer, i As Integer
   
    kalanVekilSayisi = vekilSayisi
    reyCount = -1
   
    'Dizideki rey sayılarının satır mı yoksa, sütun olarak mı verildiği duruma göre
    'boyutlandır...
    ReDim Preserve reyArray(WorksheetFunction.Max(reySayilari.Columns.Count, reySayilari.Rows.Count))
   
    For Each rng In reySayilari
        reyCount = reyCount + 1
        reyArray(reyCount) = rng
    Next
   
    ReDim vekilArray(reyCount)
   
    'Vekil sayısı dolana kadar çalış...
    Do While kalanVekilSayisi > 0
        dividerCount = dividerCount + 1
       
        reyArray(reyPos) = reyArray(reyPos) / dividerCount

        reyMax = WorksheetFunction.Max(reyArray)
       
        reyPos = WorksheetFunction.Match(reyMax, reyArray, 0) - 1
       
        vekilArray(reyPos) = vekilArray(reyPos) + 1

        kalanVekilSayisi = kalanVekilSayisi - 1
    Loop
   
    If reySayilari.Rows.Count > 1 Then
        'Rey sayıları satır olarak verildiyse döndür...
        ReDim Preserve vekilArray2(reyCount, 0)

        For i = 0 To reyCount
            vekilArray2(i, 0) = vekilArray(i)
        Next

        D_Hondt = vekilArray2
    Else
        'Rey sayıları sütun olarak verildiyse döndür...
        D_Hondt = vekilArray
    End If
   
End Function
 

Ekli dosyalar

Son düzenleme:
@Zeki Gürsoy 'un çalışması güzel ama anladığım kadarıyla bu sistemde eşitlik halinde öncelik sorunu oluşuyor ya da eşitlerden biri göz ardı ediliyor. Örneğin Zeki Bey'in dosyasında birinci parti 60 bin, ikinci parti 30 bin ve üçüncü parti 14 bin olarak çözüm arandığında 3-2-2 şeklinde sonuç veriyor. Halbuki 4-2-1 olmalıydı:

1==> 60 bin ==>A partisi
2==> 30 bin ==> A veya B partisi
3==> 30 bin ==> B veya A partisi
4==> 20 bin ==> A partisi
5==> 15 bin ==> A veya B partisi
6==> 15 bin ==> B veya A partisi
7==> 14 bin ==> C partisi
 
İkinci bir durum da örneğin ülkemizde seçim barajı uygulandığı için alınan oy sayısından geçerli oyların %10'u yani baraj düşüldükten sonra dhondt sistemi uygulanmaktadır.%10'dan az oy alan parti ve bağımsız adaylar dikkate alınmaz.
 
@YUSUF44, kod ve dosyayı gönderdikten sonra revizyon gerektiğini farkettim. Revizyon yanlış olduğu için sonuçlar da yanlış oldu; sonra düzelteceğim.

YUSUF44' Alıntı:
İkinci bir durum da örneğin ülkemizde seçim barajı uygulandığı için alınan oy sayısından geçerli oyların %10'u yani baraj düşüldükten sonra dhondt sistemi uygulanmaktadır.%10'dan az oy alan parti ve bağımsız adaylar dikkate alınmaz.
Genişletmek için tıkla ...

@Muhammet Okumuş' un bu yöntem ile ne yapacağını bilmiyoruz. Tamamen Wiki' deki açıklama doğrultusunda hazırladığım bir çalışmadır. Açıkçası çok gerekli mi, emin değilim...

.
 
Zeki Bey, öncelikle cevabınız için çok teşekkür ederim. Bunu başka bir yerde kullanacağım. Yani seçim falan değilim. Sadece anlaşılması açısından seçim örneğini verdim. Alınan sayılara göre puanları adil bir şekilde dağıtmak için kullanacağım. %10 önemli değil. Dosya mükemmel bir şekilde çalışıyor. Benim için oldukça önemli bir çalışma. Tekrardan çok teşekkür ederim.
 
228062Zeki Bey hesaplamada yanlışlık yapıyor. Aynı oyu almalarına rağmen dağılım çok farklı oluyor.
 
#8 nolu mesajımda hatalı bir revizyon yaptığımı belirtmiştim. Gece düzeltip tekrar ekleyeceğim. Kodlar anlaşılır geldiyse beni beklemeden kendiniz de düzeltebilirsiniz.
 
Muhammet Okumuş' Alıntı:
Zeki Bey hesaplamada yanlışlık yapıyor. Aynı oyu almalarına rağmen dağılım çok farklı oluyor.
Genişletmek için tıkla ...

Aşağıdaki kod ile değiştirip deneyin...

C#: 
Function D_Hondt(reySayilari As Range, vekilSayisi As Range) As Integer()
    ' Zeki Gürsoy © 01.06.2021
    ' gursoyzeki@gmail.com
    ' https://zekigursoy.blogspot.com
    '
    Dim reyCount As Integer, reyMax As Double, reyPos As Integer, kalanVekilSayisi As Integer, dividerCount As Integer, rng As Range
    Dim reyArray() As Long, vekilArray() As Integer, vekilArray2() As Integer, i As Integer
   
    kalanVekilSayisi = vekilSayisi
    reyCount = -1
   
    'Dizideki rey sayılarının satır mı yoksa, sütun olarak mı verildiği duruma göre
    'boyutlandır...
    ReDim Preserve reyArray(WorksheetFunction.Max(reySayilari.Columns.Count - 1, reySayilari.Rows.Count - 1))
   
    For Each rng In reySayilari
        reyCount = reyCount + 1
        reyArray(reyCount) = rng
    Next
   
    ReDim vekilArray(reyCount)
   
    dividerCount = 1

    'Vekil sayısı dolana kadar çalış...
    Do While kalanVekilSayisi > 0
        dividerCount = dividerCount + 1
       
        reyMax = WorksheetFunction.Max(reyArray)
       
        reyPos = WorksheetFunction.Match(reyMax, reyArray, 0) - 1
       
        vekilArray(reyPos) = vekilArray(reyPos) + 1
       
        kalanVekilSayisi = kalanVekilSayisi - 1
       
        reyArray(reyPos) = reyArray(reyPos) / dividerCount
    Loop
   
    If reySayilari.Rows.Count > 1 Then
        'Rey sayıları satır olarak verildiyse döndür...
        ReDim Preserve vekilArray2(reyCount, 0)

        For i = 0 To reyCount
            vekilArray2(i, 0) = vekilArray(i)
        Next

        D_Hondt = vekilArray2
    Else
        'Rey sayıları sütun olarak verildiyse döndür...
        D_Hondt = vekilArray
    End If
   
End Function

.
 
Trafoya kedi girmiştir.... :)

.
 
Zeki Gürsoy' Alıntı:
Aşağıdaki kod ile değiştirip deneyin...

C#: 
Function D_Hondt(reySayilari As Range, vekilSayisi As Range) As Integer()
    ' Zeki Gürsoy © 01.06.2021
    ' gursoyzeki@gmail.com
    ' https://zekigursoy.blogspot.com
    '
    Dim reyCount As Integer, reyMax As Double, reyPos As Integer, kalanVekilSayisi As Integer, dividerCount As Integer, rng As Range
    Dim reyArray() As Long, vekilArray() As Integer, vekilArray2() As Integer, i As Integer
  
    kalanVekilSayisi = vekilSayisi
    reyCount = -1
  
    'Dizideki rey sayılarının satır mı yoksa, sütun olarak mı verildiği duruma göre
    'boyutlandır...
    ReDim Preserve reyArray(WorksheetFunction.Max(reySayilari.Columns.Count - 1, reySayilari.Rows.Count - 1))
  
    For Each rng In reySayilari
        reyCount = reyCount + 1
        reyArray(reyCount) = rng
    Next
  
    ReDim vekilArray(reyCount)
  
    dividerCount = 1

    'Vekil sayısı dolana kadar çalış...
    Do While kalanVekilSayisi > 0
        dividerCount = dividerCount + 1
      
        reyMax = WorksheetFunction.Max(reyArray)
      
        reyPos = WorksheetFunction.Match(reyMax, reyArray, 0) - 1
      
        vekilArray(reyPos) = vekilArray(reyPos) + 1
      
        kalanVekilSayisi = kalanVekilSayisi - 1
      
        reyArray(reyPos) = reyArray(reyPos) / dividerCount
    Loop
  
    If reySayilari.Rows.Count > 1 Then
        'Rey sayıları satır olarak verildiyse döndür...
        ReDim Preserve vekilArray2(reyCount, 0)

        For i = 0 To reyCount
            vekilArray2(i, 0) = vekilArray(i)
        Next

        D_Hondt = vekilArray2
    Else
        'Rey sayıları sütun olarak verildiyse döndür...
        D_Hondt = vekilArray
    End If
  
End Function

.
Genişletmek için tıkla ...
Maalesef hesaplama yanlış oluyor. Önceki mesajımda belirttiğim gibi eşitlik durumunda hatalı sonuç veriyor. Denemek için birinci partiye 60 bin, ikinci partiye 30 bin vererek sonuçları inceleyebilirsiniz.
 
Muhammet Okumuş' Alıntı:
Zeki Bey, hesaplamada yanlışlıklar var.
Genişletmek için tıkla ...

YUSUF44' Alıntı:
Maalesef hesaplama yanlış oluyor. Önceki mesajımda belirttiğim gibi eşitlik durumunda hatalı sonuç veriyor. Denemek için birinci partiye 60 bin, ikinci partiye 30 bin vererek sonuçları inceleyebilirsiniz.
Genişletmek için tıkla ...

Dostlarım, hesaplamadaki adımları matematiksel olarak izah ederseniz konuyu yanlış anlayıp anlamadığımı öğrenmiş olurum.

Haluk' Alıntı:
Trafoya kedi girmiştir.... :)
.
Genişletmek için tıkla ...

Anlaşılan kedi aklıma girmiş... :)
 
İlk mesajdaki dosya için ; C2:F2 yi seçip =dHondt($C$4:$F$4;H3) girdikten sonra CTRL+SHIFT+ENTER ile bitirin.

Kod: 
Function dHondt(oylar, mvSayisi)
   
    oylar = Application.Index(oylar.Value, 0)
 
    ReDim sonuclar(1 To 1, 1 To UBound(oylar))
    
    For i = 1 To mvSayisi.Value
        mx = 0
        sira = 0
        For ii = 1 To UBound(oylar)
            bolum = (oylar(ii) / (sonuclar(1, ii) + 1))
            If bolum > mx Then
                mx = bolum
                sira = ii
            End If
        Next ii
        sonuclar(1, sira) = Val(sonuclar(1, sira)) + 1
    Next i

    dHondt = sonuclar
End Function
 
Son düzenleme:
Barajı gözardı edersek. Tüm parti ve bağımsız adayların aldıkları oylar, önce 1'e, sonra 2'ye, sonra 3'e .... olmak üzere kaç sandalye varsa o kadar bölünür. Elde edilen sonuçlar büyükten küçüğe doğru sıralanır. Bu sonuçlardan en yüksek olanlar sırasıyla kazanmış kabul edilir. Son sandalyelerde eşitlik olursa aralarında kura çekilir.

Resimde açıklamaya çalıştım:

228077
 
228086Yeşil hücreler bulunduğu satırdaki en yüksek değerlerdir. Bir parti kaç milletvekili çıkarmışsa aldığı oya bölünür ve kıyas yapılır. İlk MV A partisinden olur. 2 MV için A partisi 2 ye bölünür ve değer 62,5a düşer. Bu durumda B partisi 1 MV çıkarmış olur ve oyu 2ye bölünür.
3. koltuk A partisinden olur A partisinin başta aldığı oy 3e bölünür ve 41,6ya düşer. A partisi 3 MV çıkardığında bu durumda başta aldığı oy 4e bölünür.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst