açıklama kutusundaki değerleri toplama

[ETEKİN]

Merhaba arkadaşlar;

Hücrelerin içinde tarihler, açıklama kutusunda da değerler var.Benim sorunum, hücre içerisindeki tarihlere göre açıklama kutusundaki değerlerin nasıl toplanacağı.

Private Sub UserForm_initialize()
On Error Resume Next
For a = 2 To 6
For x = 1 To 7
If Cells(a, x).Range <= Date Then deg = deg + Cells(a, x).Comment.Visible.Value

Next x
Next a

UserForm1.Label4 = deg
end sub

Sevgi ve saygıyla

 

[hamitcan]

If Cells(a, x).Range <= Date Then deg = deg + [B]Cells(a, x).Comment.Visible.Value[/B]

satırını

If Cells(a, x).Range <= Date Then deg = deg + [B]Cells(a, x).Comment.Text[/B]

değiştirirerek dener misiniz?

 

[ETEKİN]

Hamitcan Bey
İlginiz içi teşekkür ederim.
label4 te=açıklamalarda bulunan değerlerin toplam alması gerekiyor.Fakat açıklamalarda bulunan değerler;
50,0050,00100,00 diye görünüyor.

Sevgi ve Saygıyla

 

[hamitcan]

Birden fazla rakam&#305;n olmas&#305; ve biti&#351;ik olmas&#305; &#231;&#246;z&#252;m&#252; zorla&#351;t&#305;r&#305;yor.Size &#246;nerim, a&#231;&#305;klama i&#231;inde g&#246;r&#252;nen rakamlar&#305; teke d&#252;&#351;&#252;rmeniz.

 

[ETEKİN]

Açıklmalarda tek sayı var.1.10.2007 tarihinde açıklamada tek sayı,
16.10.2007 tarihinde açıklamada tek sayı vb. bu tarihlerdeki sayıların toplamı istiyorum.

Sevgi ve Saygıyla

 

[hamitcan]

&#214;rnek bir dosya ekler misiniz ?

 

[ETEKİN]

Dosya ektedir.

 

[hamitcan]

Eski kodu, aşağıdaki ile değiştirin.

Private Sub UserForm_initialize()
On Error Resume Next
For a = 2 To 6
For x = 1 To 7
If Cells(a, x).Range <= Date Then deg = deg + Val(Cells(a, x).Comment.Text)
'If CDate(Cells(a, x).Range) = Date Then Cells(a, x).Comment.Text
'If CDate(Cells(a, x).Range) < Date Then Cells(a, x).Comment.Text
'If CDate(Cells(a, x).Range) > Date Then Cells(a, x).Comment.Text

Next x
Next a


UserForm1.Label4 = deg
UserForm1.Label5 = CDbl(deg1 + 1191.24)
UserForm1.Label6 = UserForm1.Label4 - UserForm1.Label5

'eksi değere göre kırmızı oluyor
If Label6 < 0 Then
'Label3.ForeColor = &HFF&
Label6.ForeColor = &HFF&
End If

'grafik çizimi
Dim SeriIsmi(1)
Dim Degerler(3)
Dim Sabitler

SeriIsmi(0) = "Örnek Değer"
Degerler(0) = Val(Me.Label4.Caption)
Degerler(1) = Val(Me.Label5.Caption)
Degerler(2) = Val(Me.Label6.Caption)
With ChartSpace1
Set c = .Constants
.Charts.Add
' Grafiği dizilere bağlar.
With .Charts(0)
'.Type = c.chChartTypeArea
.SetData c.chDimSeriesNames, chDataLiteral, SeriIsmi
.SeriesCollection(0).SetData c.chDimValues, chDataLiteral, Degerler
End With
End With

End Sub

 

[ETEKİN]

Hamitcan Bey;
Kodlarınız mükemmel çalışıyor.Çok teşekkür ederim.

Aynı açıklamada iki değer olursa nasıl olur?

 

[hamitcan]

Olmasa daha iyi desem. Şaka bir tarafa, rakamları birbirinden ayırmak için bir ayıraç kullanmalısınız. Kısaca, rakamları bir standarta oturtmalısınız.

 

[ETEKİN]

Şunu demek istemiştim.
1.açıklamada 500,00 ve 200,00 değerleri
2.açıklamada 200,00 değeri
toplam 900,00 olması gibi.

 

[hamitcan]

Kodu biraz değiştirdim.
Not: Açıklamalardaki rakamları (Örn:5+6+7 gibi yazdığınızı varsaydım.)

Function aciklamalaritopla()
On Error Resume Next
For Each hucre In [a2:g6].SpecialCells(xlCellTypeComments)
If hucre <= Date Then
sonuc = Split(hucre.Comment.Text, "+")
For i = 0 To Len(hucre.Comment.Text)
topla = topla + Val(sonuc(i))
Next
End If
Next
aciklamalaritopla = topla
End Function


Private Sub UserForm_initialize()
On Error Resume Next


UserForm1.Label4 = aciklamalaritopla
UserForm1.Label5 = CDbl(deg1 + 1191.24)
UserForm1.Label6 = UserForm1.Label4 - UserForm1.Label5

'eksi değere göre kırmızı oluyor
If Label6 < 0 Then
'Label3.ForeColor = &HFF&
Label6.ForeColor = &HFF&
End If

'grafik çizimi
Dim SeriIsmi(1)
Dim Degerler(3)
Dim Sabitler

SeriIsmi(0) = "Örnek Değer"
Degerler(0) = Val(Me.Label4.Caption)
Degerler(1) = Val(Me.Label5.Caption)
Degerler(2) = Val(Me.Label6.Caption)
With ChartSpace1
Set c = .Constants
.Charts.Add
' Grafiği dizilere bağlar.
With .Charts(0)
'.Type = c.chChartTypeArea
.SetData c.chDimSeriesNames, chDataLiteral, SeriIsmi
.SeriesCollection(0).SetData c.chDimValues, chDataLiteral, Degerler
End With
End With
End Sub

 

[ETEKİN]

Harikasınız! Çok teşekkür ederim.