- Katılım
- 2 Mart 2005
- Mesajlar
- 2,960
- Excel Vers. ve Dili
-
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Ekli dosyada combalardan seçilen değerlere göre iki eksenli (yüzde ve sayı) gösteren grafik oluşturulmaktadır. iki sorum var;
1-) Oy Yüzde kısmında değerlerin üç ondalıklı olarak gösterilmesidir. yani 38,58327054 yerine 38,583 şeklinde gösterilmesi için grafik oluşturma kodlarında yapılması gereken değişiklik nedir?
diğer bir ifade ile ( .SeriesCollection(2) ) nin numberformatı nasıl belirlenir?
2-) Aynı grafikte oy kullanan secmen sayısı, Geçerli oy pusularının toplamı, Oy kullanmayan secmen sayısı (Tabloda yok C-Ç sonucundan bulunacaktır.) değerlerinide tablonun solunda göstermektir. Diğerleri geçerli oyların yüzdelik dağılımıdır.
1-) Oy Yüzde kısmında değerlerin üç ondalıklı olarak gösterilmesidir. yani 38,58327054 yerine 38,583 şeklinde gösterilmesi için grafik oluşturma kodlarında yapılması gereken değişiklik nedir?
diğer bir ifade ile ( .SeriesCollection(2) ) nin numberformatı nasıl belirlenir?
2-) Aynı grafikte oy kullanan secmen sayısı, Geçerli oy pusularının toplamı, Oy kullanmayan secmen sayısı (Tabloda yok C-Ç sonucundan bulunacaktır.) değerlerinide tablonun solunda göstermektir. Diğerleri geçerli oyların yüzdelik dağılımıdır.
Kod:
Private wrkBKtp As Workbook
Private wshDATA As Worksheet
Private chrSONUC As Chart
Private arrSCEV()
Private arrBASLIKLAR()
Private arrSUTUNNO()
Private arrOYADT()
Private arrOYYZD()
Private Sub UserForm_Initialize()
Set chrSONUC = ThisWorkbook.Sheets("SONUCGRAFIGI")
Set wrBKtp = ThisWorkbook
Dim shDSyf As Object
ReDim arrSCEV(1, 0)
ReDim arrBASLIKLAR(0)
ReDim arrSUTUNNO(0)
ReDim arrSSYSNC(0)
ReDim arrYZDSNC(0)
For Each shDSyf In wrBKtp.Worksheets
If shDSyf.Type = xlWorksheet Then
cbxSCMYIL.AddItem shDSyf.Name
End If
Next
cbxSCMCVR.ColumnCount = 2
End Sub
Private Sub UserForm_Terminate()
Set shDSyf = Nothing
Set wshDATA = Nothing
Set rngSONDHC = Nothing
Set chrSONUC = Nothing
Erase arrSCEV, arrBASLIKLAR, arrSUTUNNO, arrOYADT, arrOYYZD
End Sub
Private Sub cbxSCMYIL_Change()
If cbxSCMYIL.Text = "" Then Exit Sub
Set wshDATA = ThisWorkbook.Sheets(cbxSCMYIL.Text)
Dim rngDATA As Range, rngSONDDHC As Range ', rngSONYDHC As Range
Dim intX As Integer, intY As Integer
'Seçim çevrelerini ve bulunduğu satırları Comboboxa aldık.
intX = 0: intY = 0
Set rngSONDHC = wshDATA.Range("a7:a" & wshDATA.Range("a65536").End(3).Row) ''Toplam satırı dahil son dolu satırı bulur.
'intSONSAT = wshDATA.Range ("a7:a" & wshDATA.Range("a65536").End(3).End(3).Row) 'Toplam satırından bir önceki dolu satırı bulur
cbxSCMCVR.Clear
For Each rngDATA In rngSONDHC
If rngDATA.Text <> "" Then
ReDim Preserve arrSCEV(1, intX)
arrSCEV(0, intX) = rngDATA.Value
arrSCEV(1, intX) = rngDATA.Row
intX = intX + 1
End If
Next rngDATA
cbxSCMCVR.Column = arrSCEV
Call sbGrafik
End Sub
Private Sub cbxSCMCVR_Change()
If cbxSCMCVR.Text = "" Then Exit Sub
Call sbGrafik
End Sub
Private Sub chk1_Click()
If chk1.Value = True Then
chk1.Caption = "Tüm partiler"
Else
chk1.Caption = "Sadece Oy Alan Partiler"
End If
Call sbGrafik
End Sub
Private Sub sbGrafik()
i = 0
If cbxSCMCVR.Text <> "" Then
intX = cbxSCMCVR.List(cbxSCMCVR.ListIndex, 1)
Else
ReDim Preserve arrBASLIKLAR(i)
arrBASLIKLAR(i) = "BOS"
ReDim Preserve arrSUTUNNO(i)
arrSUTUNNO(i) = 0
ReDim Preserve arrOYADT(i)
arrOYADT(i) = 0
ReDim Preserve arrOYYZD(i)
arrOYYZD(i) = 0
GoTo grafikciz
End If
'Seçime giren partileri ve sütun numaralarını dizilere aldık.
i = 0
For intY = 10 To 40 Step 2
If chk1.Value = False Then
If wshDATA.Cells(4, intY) <> "" Then
ReDim Preserve arrBASLIKLAR(i)
arrBASLIKLAR(i) = wshDATA.Cells(4, intY).Value
ReDim Preserve arrSUTUNNO(i)
arrSUTUNNO(i) = wshDATA.Cells(4, intY).Column
ReDim Preserve arrOYADT(i)
arrOYADT(i) = wshDATA.Cells(intX, intY).Value
ReDim Preserve arrOYYZD(i)
arrOYYZD(i) = wshDATA.Cells(intX, intY + 1).Value
i = i + 1
End If
Else
If wshDATA.Cells(intX, intY).Value <> 0 Then
ReDim Preserve arrBASLIKLAR(i)
arrBASLIKLAR(i) = wshDATA.Cells(4, intY).Value
ReDim Preserve arrSUTUNNO(i)
arrSUTUNNO(i) = wshDATA.Cells(4, intY).Column
ReDim Preserve arrOYADT(i)
arrOYADT(i) = wshDATA.Cells(intX, intY).Value
ReDim Preserve arrOYYZD(i)
arrOYYZD(i) = wshDATA.Cells(intX, intY + 1).Value
i = i + 1
End If
End If
Next intY
i = 0
' Stop
'=====================================================================================\\\
'*\ Grafik_Şeklini oluştur
grafikciz:
If Mid(cbxSCMYIL.Text, 5, 1) = "B" Then
a = "Başkanlığı Seçimleri"
ElseIf Mid(cbxSCMYIL.Text, 5, 1) = "İ" Then
a = "İl Genel Mec. Üy. Seçimleri"
End If
With chrSONUC
.ChartTitle.Characters.Text = Left(cbxSCMYIL.Text, 4) & " yılı " & cbxSCMCVR.Text & " " & a
.SeriesCollection(1).XValues = arrBASLIKLAR
.SeriesCollection(1).Values = arrOYADT
.SeriesCollection(1).Name = "Oy/Adet"
.SeriesCollection(2).XValues = arrBASLIKLAR
.SeriesCollection(2).Values = arrOYYZD
' Selection.TickLabels.NumberFormat = "0,000"
' .SeriesCollection(2).NumberFormat = "0,000"
.SeriesCollection(2).Name = "Oy/Yüzde"
.Activate
End With
'=====================================================================================///
End Sub
Ekli dosyalar
-
61.1 KB Görüntüleme: 8
-
407 KB Görüntüleme: 17