Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Sub D_Hondt_Hesaplama()
- Dim partiAdet As Integer
- Dim partiOylar() As Double
- Dim milletvekiliSayisi As Integer
- Dim milletvekili() As Integer
- Dim partiIsimleri() As String ' Yeni değişken
- partiAdet = 12 ' Parti sayısını buraya girin
- ' Excel tablosundan parti oy sayılarını alın
- ReDim partiOylar(1 To partiAdet)
- ReDim partiIsimleri(1 To partiAdet) ' Yeni dizi boyutunu ayarlayın
- For i = 2 To partiAdet + 1 ' 2. satırdan başlayarak oy sayılarını ve isimlerini alır
- partiOylar(i - 1) = Sheets("Sayfa1").Cells(i, 2).Value ' Oy sayılarının olduğu sütun numarasını buraya girin
- partiIsimleri(i - 1) = Sheets("Sayfa1").Cells(i, 1).Value ' Parti isimlerinin olduğu sütun numarasını buraya girin
- Next i
- milletvekiliSayisi = Sheets("Sayfa1").Cells(1, 7).Value ' Çıkarılacak toplam milletvekili sayısını tablodan alın
- ReDim milletvekili(1 To partiAdet)
- ' Tüm partilerin milletvekili sayısını başlangıçta sıfıra ayarlayın
- For i = 1 To partiAdet
- milletvekili(i) = 0
- Next i
- For j = 1 To milletvekiliSayisi
- Dim maxOy As Double
- Dim maxIndex As Integer
- maxOy = 0
- maxIndex = 0
- ' En fazla oy alan partiyi bulun
- For i = 1 To partiAdet
- If partiOylar(i) / (milletvekili(i) + 1) > maxOy Then
- maxOy = partiOylar(i) / (milletvekili(i) + 1)
- maxIndex = i
- End If
- Next i
- ' En fazla oy alan partiye bir milletvekili ekleyin
- milletvekili(maxIndex) = milletvekili(maxIndex) + 1
- Next j
- ' Sonuçları Excel tablosuna yazdırın
- For i = 1 To partiAdet
- Sheets("Sayfa1").Cells(i + 1, 4).Value = milletvekili(i) ' 4. sütuna yazdırır
- Next i
- ' Sonuçları MsgBox ile gösterin
- Dim sonuc As String
- sonuc = "Bu oylara göre partilerin çıkarabilecekleri Milletvekili Sayıları:" & vbNewLine & vbNewLine
- ' Parti isimleri ve milletvekili sayılarını bir diziye aktarın
- Dim sonucDizi() As Variant
- ReDim sonucDizi(1 To partiAdet, 1 To 2)
- For i = 1 To partiAdet
- If milletvekili(i) > 0 Then ' Milletvekili sayısı 0'dan büyükse sonuçlara ekle
- sonucDizi(i, 1) = partiIsimleri(i)
- sonucDizi(i, 2) = milletvekili(i)
- End If
- Next i
- ' Milletvekili sayısına göre büyükten küçüğe sıralama yapın
- Dim temp As Variant
- For i = 1 To partiAdet - 1
- For j = i + 1 To partiAdet
- If sonucDizi(j, 2) > sonucDizi(i, 2) Then
- ' Değerleri yer değiştirin
- temp = sonucDizi(i, 1)
- sonucDizi(i, 1) = sonucDizi(j, 1)
- sonucDizi(j, 1) = temp
- temp = sonucDizi(i, 2)
- sonucDizi(i, 2) = sonucDizi(j, 2)
- sonucDizi(j, 2) = temp
- End If
- Next j
- Next i
- ' Sıralanmış sonuçları MsgBox ile gösterin
- For i = 1 To partiAdet
- If Not IsEmpty(sonucDizi(i, 1)) Then
- sonuc = sonuc & sonucDizi(i, 1) & ": " & sonucDizi(i, 2) & " milletvekili" & vbNewLine
- End If
- Next i
- MsgBox sonuc
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement