• DİKKAT

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

TOPLAM RAKAMIN KURUŞLU OLMASI

O

Ongun

Katılım
24 Mayıs 2005
Mesajlar
462
Excel Vers. ve Dili
Excel 2003 Türkçe
TOPLAM RAKAMIN KURUÞLU OLMASI

Arkadaşlar, aşagıda yazılı kod ile 4 adet TextBox`a girilen rakamlar TextBox12`ye otamatik olarak topluyor. Ancak "TextBox12 = Format((TextBox12.Value), "#,##0.00-YTL")" bir hata var galiba çünkü formatta hata veriyor. yani toplamın YTL ye göre görünmesini istiyorum. Lütfen yardım edermisiniz.

Private Sub TextBox12_Change()
On Error Resume Next
TextBox12 = Format((TextBox12.Value), "#,##0.00-YTL")
a = Round(TextBox9, 2)
a = WorksheetFunction.Substitute(a, ",", ".")
b = Round(TextBox10, 2)
b = WorksheetFunction.Substitute(b, ",", ".")
c = Round(TextBox11, 2)
c = WorksheetFunction.Substitute(c, ",", ".")
d = Round(TextBox19, 2)
d = WorksheetFunction.Substitute(d, ",", ".")
z = Val(a) + Val(b) + Val(c) + Val(d)
z = WorksheetFunction.Substitute(z, ".", ",")
TextBox12 = z
End Sub

Ayrıca, Round`un buradaki işlevini açıklarmısınız. Teşekkürler.
 
Merhaba

Yuvarla demek

123,3576
123,36

gibi

Ayrıca formatta sorun yok makroyu commandbutona baglayın

textbox formatıda aşağıdaki gibi değiştirin
TextBox12 = Format(z, "#,##0.00-YTL")
 
Sayın Zafer bey, ilginize teşekkür ederim. Aşağıdaki kodları incelermisiniz. Hatanın nedenini anlayamadım. "On Error Resume Next" koymadığım takdirde hata veriyor.
Private Sub TextBox9_Change()
On Error Resume Next
TextBox12 = CCur(TextBox9.Value * 1)
End Sub

Private Sub TextBox10_Change()
On Error Resume Next
TextBox12 = CCur(TextBox9.Value * 1) + CCur(TextBox10.Value * 1)
End Sub

Private Sub TextBox11_Change()
On Error Resume Next
TextBox12 = CCur(TextBox9.Value * 1) + CCur(TextBox10.Value * 1) + CCur(TextBox11.Value * 1)
End Sub

Private Sub TextBox19_Change()
On Error Resume Next
TextBox12 = CCur(TextBox9.Value * 1) + CCur(TextBox10.Value * 1) + CCur(TextBox11.Value * 1) + CCur(TextBox19.Value * 1)
End Sub

Private Sub TextBox12_Change()
On Error Resume Next
a = Round(TextBox9, 2)
a = WorksheetFunction.Substitute(a, ",", ".")
b = Round(TextBox10, 2)
b = WorksheetFunction.Substitute(b, ",", ".")
c = Round(TextBox11, 2)
c = WorksheetFunction.Substitute(c, ",", ".")
d = Round(TextBox19, 2)
d = WorksheetFunction.Substitute(d, ",", ".")
z = Val(a) + Val(b) + Val(c) + Val(d)
z = WorksheetFunction.Substitute(z, ".", ",")
TextBox12 = z
TextBox12 = Format(z, "#,##0.00")
End Sub

Yukarıdaki kodların açıklaması şöyle;
9,10,11,19 nolu textbox`lara rakamı (örnek:1.500,50) şeklinde giriyorum. Her textbox a girdiğim rakamdan sonra Enter`e basınca TextBox12 de otamatik toplam alıyor. Ancak, "On Error Resume Next" ifadesini kodun başına yazmayınca hata veriyor.
Sorum şöyle: Bu hatanın neden kaynaklandığı konusunda bana bilgi verebilirmisiniz. Sayğılarımla
 
Merhaba

textbox12'ye hiç bir şey yazmayın

Private Sub TextBox9_Change()
TextBox12 = Round(CCur(TextBox9.Value * 1), 2)
End Sub

Private Sub TextBox10_Change()
TextBox12 = Round(CCur(TextBox9.Value * 1), 2) + Round(CCur(TextBox10.Value * 1), 2)
End Sub

Private Sub TextBox11_Change()
TextBox12 = Round(CCur(TextBox9.Value * 1), 2) + Round(CCur(TextBox10.Value * 1), 2) + Round(CCur(TextBox11.Value * 1), 2)
End Sub

Private Sub TextBox19_Change()
TextBox12 = Round(CCur(TextBox9.Value * 1), 2) + Round(CCur(TextBox10.Value * 1), 2) + Round(CCur(TextBox11.Value * 1), 2) + Round(CCur(TextBox19.Value * 1), 2)
End Sub
 
Merhaba, sanırım çok soru sormaya başladım. Beni bağışlayın, bu kodlarla bağlantılı olarak aşağıdaki kodları kullanıyorum. Yine kodlarımın başında On Error Resume Next var. Olmasa hata veriyor. Bu kodlardaki hatanın nedenini de açıklarsanız sevinirim. sevgiyle kalın.

Private Sub TextBox9_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
On Error Resume Next
Sheets("Sayfa3").Select
For satir = 1 To Cells(65536, 2).End(xlUp).Row
If Sayfa3.Cells(satir, 2) = TextBox13.Text And Sayfa3.Cells(satir, 4) = TextBox15.Text And Sayfa3.Cells(satir, 5) < Val(Sayfa3.Cells(satir, 13)) + Val(TextBox12.Value * 1) Then MsgBox "MİKTAR YETERSİZ!", 48, "DİKKAT": TextBox9.Text = "": Exit For
Next
End Sub

Private Sub TextBox10_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
On Error Resume Next
Sheets("Sayfa3").Select
For satir = 1 To Cells(65536, 2).End(xlUp).Row
If Sayfa3.Cells(satir, 2) = TextBox13.Text And Sayfa3.Cells(satir, 4) = TextBox15.Text And Sayfa3.Cells(satir, 5) < Val(Sayfa3.Cells(satir, 13)) + Val(TextBox12.Value * 1) Then MsgBox " MİKTAR YETERSİZ!", 48, "DİKKAT": TextBox10.Text = "": Exit For
Next
End Sub

Private Sub TextBox11_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
On Error Resume Next
Sheets("Sayfa3").Select
For satir = 1 To Cells(65536, 2).End(xlUp).Row
If Sayfa3.Cells(satir, 2) = TextBox13.Text And Sayfa3.Cells(satir, 4) = TextBox15.Text And Sayfa3.Cells(satir, 5) < Val(Sayfa3.Cells(satir, 13)) + Val(TextBox12.Value * 1) Then MsgBox " MİKTAR YETERSİZ!", 48, "DİKKAT": TextBox11.Text = "": Exit For
Next
End Sub

Private Sub TextBox19_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
On Error Resume Next
Sheets("Sayfa3").Select
For satir = 1 To Cells(65536, 2).End(xlUp).Row
If Sayfa3.Cells(satir, 2) = TextBox13.Text And Sayfa3.Cells(satir, 4) = TextBox15.Text And Sayfa3.Cells(satir, 5) < Val(Sayfa3.Cells(satir, 13)) + Val(TextBox12.Value * 1) Then MsgBox " MİKTAR YETERSİZ!", 48, "DİKKAT": TextBox19.Text = "": Exit For
Next
End Sub


Ã?nemli Not: Bu kodları kullanarak çalışma sayfası hücrelerinde kuruşlu çıkarma ve toplama yaptırmayı başardım. örnek: Textbox`a 1.500,20 girdiğinizde hücredeki daha önce kayıtlı tutarın üzerinden çıkarma veya toplama yı kuruşlu olarak yapabiliyor. kuruşun sonu sıfır olsada fark etmiyor. Tanıyor.
 
Merhaba

If Sayfa3.Cells(satir, 2)

if Sheets("Sayfa3").Cells(satir, 2)

olarak değiştirin

hata verirse
On Error Resume Next satırını kaldırın ne hatası verdiğine bakın
 
Selam,
On Error Resume Next satırını KALDIRINCA "Type mismatch" hatası veriyor. Zaten benim amacımda bu satırı kaldırınca neden bu hatayı verdiğini anlamaya çalışıyorum. öte yandan, bu satırı yazarsam saat gibi çalışıyor. Eğer beni aydınlatırsanız sevinirim. "On Error Resume Next" satırını YAZMADAN bu iş olmaz mı?
 
Sizin aynı kodlarınızı yazıp bir daha inceliyeyim

Sayfa seçimi doğru üstte ben atlamışım
 
Merhaba


Val(TextBox12.Value * 1)'i

val(textbox12) olarak değiştirin

nasıl olacak
 
Merhaba


Val(TextBox12.Value * 1)'i

val(textbox12) olarak değiştirin

nasıl olacak
 
Merhaba, dediğiniz gibi yaptım yine hata verdi."Type mismatch" hatası veriyor
Private Sub TextBox9_Change()
TextBox12 = Round(CCur(TextBox9.Value * 1), 2) (burası sarıya boyandı)"hata"!
End Sub
 
Merhaba

Change olayına yazdıklarımızı

TextBox12 = Round(CCur(TextBox9.Value * 1), 2)
gibi

Beforeupdate nin en üst satırına alırmısınız

change olaylarını silin
 
Selam, ddediğiniz gibi yaptım "MİKTAR YETERSİZ!", mesajı veriyor oysa miktar yeterli. Sanırım, "On Error Resume Next" ifadesini kodlarımın başına yazmam gerekiyor. bir türlü çözemedim.
 
Merhaba,

CCur fonksiyonu eğer textbox9 boş ise yada sayısal olmayan bir değerse bu hataya sebep oluyor.

En kolay çözüm baş tarafa On Error Resume Next satırını eklemek.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst