Rakamı TL olarak Yazıya çevirme?

[atemi2000]

Selam Arkadaşlar;
Örneğin; 155,50 YTL yi #Yüzellibeş TL Elli KR# şekline sokabilecek bir formüle ihtiyacım var Saygılar..

 

[muygun]

Merhaba
Syn. Levent Menteşoğlu'nun güzel bir çalışmasını aşağıdaki linkten bulabilirsiniz.
http://www.excel.web.tr/f116/say-y-y...kr-t12077.html

 

[rasim535]

Function Yaziyla(Sayi#)
Dim virgul2 As String
Dim cevap As String
Dim yazi As String
Dim Say As String
Dim uclu As String
Dim virgul As Integer
Dim o As Integer
Dim b As Integer
Dim x As Integer
Dim i As Integer
Dim y As Integer
Dim TL As String
Dim Kr As String

If Sayi# = 0 Then Yaziyla = "SIFIR": Exit Function

ReDim birler$(10), onlar$(10), BASAMAK$(5)

birler$(0) = "": birler$(1) = "BİR"
birler$(2) = "İKİ": birler$(3) = "ÜÇ"
birler$(4) = "DÖRT": birler$(5) = "BEŞ"
birler$(6) = "ALTI": birler$(7) = "YEDİ"
birler$(8) = "SEKİZ": birler$(9) = "DOKUZ"

onlar$(0) = "": onlar$(1) = "ON"
onlar$(2) = "YİRMİ": onlar$(3) = "OTUZ"
onlar$(4) = "KIRK": onlar$(5) = "ELLİ"
onlar$(6) = "ALTMIŞ": onlar$(7) = "YETMİŞ"
onlar$(8) = "SEKSEN": onlar$(9) = "DOKSAN"

BASAMAK$(1) = "": BASAMAK$(2) = "BİN "
BASAMAK$(3) = "MİLYON ": BASAMAK$(4) = "MİLYAR "
BASAMAK$(5) = "TRİLYON "

virgul2 = ""
cevap = ""

'AŞAĞIDAKİ 2 SATIRDAKİ ÇİFT TIRNAK İÇERİĞİNİ DEĞİŞTİREREK
'VEYA ÇİFT TIRNAĞIN ARASINI SİLEREK "" VEYA "," GİBİ
'İSTEĞİNİZ SONUCUN ÇIKMASINI SAĞLAYABİLİRSİNİZ.
TL = ".-TL., "
Kr = ".-Kr."

Say = Str$(Sayi#)
virgul = InStr(1, Say, ".")
If virgul Then

'Aşağadaki satır 26,4 Yirmialtı TL, KIRK Kr olarak okutur.
' (Yirmialtı TL, DÖRT Kr olarak değil)
'İptal etmek isterseniz başına bir ' tek tırnak işareti koyunuz
If Len(Mid(Say, virgul + 1)) = 1 Then Say = Say + "0"

Say = Right$(Say, Len(Say) - virgul)
GoSub cevir

If cevap = "" Then Kr = ""
virgul2 = cevap + Kr
cevap = ""

Say = Str$(Sayi#)
Say = Left$(Say, virgul - 1)
End If
GoSub cevir
If cevap = "" Then TL = ""
Yaziyla = cevap + TL + virgul2
Exit Function

cevir:
x = Len(Say)
Say = String$(3 - (x - Int(x / 3) * 3), 48) + Say
x = Len(Say) / 3
For i = 1 To x
uclu = Mid$(Say, Len(Say) - i * 3 + 1, 3)
y = Val(Mid$(uclu, 1, 1))
o = Val(Mid$(uclu, 2, 1))
b = Val(Mid$(uclu, 3, 1))

yazi = ""
If y <> 0 Then
If y > 1 Then yazi = birler$
yazi = yazi + "YÜZ "
End If

yazi = yazi + onlar$(o) + birler$(b)

If yazi <> "" Then
If LCase(yazi) = "BİR" And i = 2 Then yazi = ""
If yazi = "BİR" And BASAMAK$(i) = "BİN " Then
cevap = BASAMAK$(i) + cevap
Else
cevap = yazi + BASAMAK$(i) + cevap
End If
End If
Next i
If Sayi# < 0 Then cevap = "-Eksi-" + cevap
Return
End Function

 

[müdürüm]

arkadaşım nacizane bende sana şu çözüm önerisini sunayım. islem yapacağın exel dosyasını açınca Görünüm>Araç çubukları>Visual Basic'i seç çıkan ekrandan Visual Basic düzenleyicisini seç ( büyük ihtimal simge halindedir üzerine gelince altında yazar ) karşına visual basic düzenleyicisi çıkacak orada sol bölmede en altta "module" kısmına yeni bir sayfa açıp aşağıdaki kodları aynen kopyala
Public Function ParaCevir(Para)
Dim ParaStr As String
Dim TL As String, Kurus As String

If Not IsNumeric(Para) Then GoTo SayiDegil

ParaStr = Format(Abs(Para), "0.00")

TL = Left(ParaStr, Len(ParaStr) - 3)
Kurus = Right(ParaStr, 2)

ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(TL) & " TL " & Cevir(Kurus) & " Krs"

Exit Function

SayiDegil:
ParaCevir = "GİRİLEN DEĞER SAYI DEĞİL!"
End Function
Sub bicim4()
'/- sayıları yuvarla
'/- 100 sayısını döndürür
[A2].Value = Int(100.4 + 0.5)
End Sub


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

daha sonra visual basic'den çık ve metni yazdırmak istediğin hücreye =paraçevir(hangi hücredeki rakamı yazdırmak istiyorsan)şeklinde yaz işlem tamamdır.

 

[keyaksar]

arkadaşım nacizane bende sana şu çözüm önerisini sunayım. islem yapacağın exel dosyasını açınca Görünüm>Araç çubukları>Visual Basic'i seç çıkan ekrandan Visual Basic düzenleyicisini seç ( büyük ihtimal simge halindedir üzerine gelince altında yazar ) karşına visual basic düzenleyicisi çıkacak orada sol bölmede en altta "module" kısmına yeni bir sayfa açıp aşağıdaki kodları aynen kopyala
Public Function ParaCevir(Para)
Dim ParaStr As String
Dim TL As String, Kurus As String

If Not IsNumeric(Para) Then GoTo SayiDegil

ParaStr = Format(Abs(Para), "0.00")

TL = Left(ParaStr, Len(ParaStr) - 3)
Kurus = Right(ParaStr, 2)

ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(TL) & " TL " & Cevir(Kurus) & " Krs"

Exit Function

SayiDegil:
ParaCevir = "GİRİLEN DEĞER SAYI DEĞİL!"
End Function
Sub bicim4()
'/- sayıları yuvarla
'/- 100 sayısını döndürür
[A2].Value = Int(100.4 + 0.5)
End Sub


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

daha sonra visual basic'den çık ve metni yazdırmak istediğin hücreye =paraçevir(hangi hücredeki rakamı yazdırmak istiyorsan)şeklinde yaz işlem tamamdır.

Sevgili arkadaşım verdiğin kod için teşekkür ederim çok işime yarayacak.Fakat mesela 500,00 TL yazıyorum yazıyla beşyüz TL 00 KRS yazıyor bu durumu nasıl düzeltebiliriz.

 

[parametre]

Sevgili arkadaşım verdiğin kod için teşekkür ederim çok işime yarayacak.Fakat mesela 500,00 TL yazıyorum yazıyla beşyüz TL 00 KRS yazıyor bu durumu nasıl düzeltebiliriz.

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"kırmızı olan yeri " "işareti koyun sorununuz cozulecektir kolay gelsin

 

[msuykucu]

üstadlarıma iyi günler
daha yolun başındayım
vermiş olduğunuz kodda 61,9308 (hücre biçimlendirden iki basamak göster işaretlememe rağmen
yazıyla Altmışbir. TL.Dokuzbinüçyüzsekiz Krş. geliyor
bilmem derdimi anlatabildimmi
benim istediğim kuruş hanesinin iki hücreden oluşmasını sağlamak (61,93)
dolayısıyla Altmışbir TL.Doksanüç Krş.
ilginize şimdiden teşekkürler...

 

[dignity]

bu da sayfa üzerinden yazıya çevirme denemesi
yalnız 99.999,99 a kadar tabii

 

[ERKANBAŞARAN]

ÖNEMLİİİİİİİ

Biri bana excelde tl rakamını yazıya çevirmeyi anlatırmı bir türlü çözemiyorum

 

[oguncu]

rakamyaz

formülle yaptığım işlem. işinize yarayabilir.

 

[zekeriya torun]

sayın arkadaşlar bende sayın Levent beyin çalışmasını kullanıyorum.çok kolay pratik.iyi çalışmalar.
http://www.excel.web.tr/f48/rakam-yaz-ya-cevirme-t70939.html#post386331