Kuruşu ayrı hücreye ayırma?

[mars2]

İyi Yıllar;
Çalışma kitabımda 1. sayfada bulunan tabloda C2:C12 arasında aylar, D212 hücrelerinde ise YTL'li fiyatlar bulunmakta, 2. sayfasında ise C1 hücresine bu YTL bedelinin Lirası, D1 hücresine ise kuruşu yazdırmak için gereken makro nedir?
Ã?rnek;
Sayfa1
C Sutunu D Sutunu
Ocak 125,52
şubat 456,54
..
..
..
..
Aralık 879,90

bulunmaktadır.
Sayfa2

C1 125 (Ã?rnek olarak Ocak ayı) ( Lirası yazılacak)
D1 52 (Ã?rnek olarak Ocak ayı) ( kuruşu yazılacak)

 

[tirvana]

makrosuz olarak
c1 hücresine =TABANAYUVARLA(A1;1)
d1 hücresine =(A1-C1)*100

a1 olarak asıl değerin bulunduğu hücreyi kastettim(125,52)

 

[mars2]

Sayın tirvana;
rakamları tavana yuvarlamak istemiyorum.
1. sayfadaki kuruşlu rakamı, 2. sayfada farklı hücrelere kuruşunu ayrı lirasın ayrı yere yazdırmak istiyorum.

 

[Ali]

Ekteki örneği inceleyin. Makrosu modülün içindedir. Umarım işiniz görür.

 

[iznik]

arkadaşlar ekteki dosyayı göremiyorum.

 

[abazya]

Logout [ iznik ] Þeklinde giriş yaparsan görmen gerekir

 

[arslan]

Arkadaşlar hücredeki kuruşlu rakamı Ã?rnek123,45)gibi. İki ayrı textboxa kuruş ayırarak nasıl alabilirim .1.textboxta (123) ikinci textboxta(45) gibi

 

[Ali]

Sn arslan, ekteki lira-kurus dosyasının içinde istediğiniz şey var indirip bir inceleyin.

Ayrıca aşağıdaki linkte ilgili fonksiyonun kullanımını daha önceden hazırlamıştım
Umarım başka çalışmalarınız içinde faydası olur.

http://www.excel.web.tr/viewtopic.php?t=11195

 

[heft]

SELAMLAR
KONUYA BAÐLI OLARAK HÜCREDE YAZAN 125,52 Yİ YİNE AYNI HÜCREDE
"125 YTL 52 KR" OLARAK G�STERME ÞANSIMIZ VAR MI?

 

[Ali]

Aşağıdaki gibi deneyin

=TAMSAYI(A1)&" YTL " & YUVARLA((A1-TAMSAYI(A1))*100;2) &" KURUÞ"

 

[Zeki Gürsoy]

Çok güzel, ama buYtl ve kuruş ifadesini yazı ile "yüzyirmibeş ytl elliiki krş" şeklinde yazılabilir mi?

 

[Ali]

Aşağıdaki kodları modüle yapıştırın.
A1 hücresine 125,52 yazıp B1 hücresinede =LiraCevir(A1) yazdığınızda yüzyirmibeş ytl elliiki kr yazacaktır.



Public Function LiraCevir(Lira)
Dim LiraStr As String
Dim YTL As String, Kurus As String

If Not IsNumeric(Lira) Then GoTo Sayiolmali

LiraStr = Format(Abs(Lira), "0.00")

YTL = Left(LiraStr, Len(LiraStr) - 3)
Kurus = Right(LiraStr, 2)

LiraCevir = IIf(Lira < 0, "Eksi ", "") & Cevir(YTL) & " YTL " & Cevir(Kurus) & " Kr"

Exit Function

Sayiolmali:
LiraCevir = "Lütfen sayı girin"
End Function



Private Function Cevir(SayiStr As String) As String
Dim Rakam(15)
Dim c(3), Sonuc, e

Birler = Array("", "bir", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz")
Onlar = Array("", "on", "yirmi", "otuz", "kırk", "elli", "altmış", "yetmiş", "seksen", "doksan")
Binler = Array("trilyon ", "milyar ", "milyon ", "bin ", "")

SayiStr = String(15 - Len(SayiStr), "0") + SayiStr

For i = 1 To 15
Rakam(i) = Val(Mid$(SayiStr, i, 1))
Next i

Sonuc = ""
For i = 0 To 4
c(1) = Rakam(i * 3 + 1)
c(2) = Rakam(i * 3 + 2)
c(3) = Rakam(i * 3 + 3)
If c(1) = 0 Then
e = ""
ElseIf c(1) = 1 Then
e = "yüz"
Else
e = Birler(c(1)) + "yüz"
End If
e = e + Onlar(c(2)) + Birler(c(3))
If e <> "" Then e = e + Binler(i)
If (i = 3) And (e = "birbin ") Then e = "bin "
Sonuc = Sonuc + e
Next i

If Sonuc = "" Then Sonuc = "00"

Cevir = UCase(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1)
End Function