RAKAMI METİN HALİNE ÇEVİRMEK

[MURAT_CAN]

RAKAMI METÝN HALÝNE ÇEVÝRMEK

ARKADAÞLAR BU BENİM İÇİN ÇOK Ã?NEMLİ BİRİSİYLE İDDAYA GİRDİM VE ONU KAZANMAK İSTİYORUM.

BENİM SORUM RAKAMI YAZIYA ÇEVİRMEK İSTİYORUM EXCELDE MESELA; 2.000 YTL yi (ikibinyenitürklirası) olarak yazmak istiyorum bana bi kişi bunu nasıl yapacağımı söylermi lütfen mail adresim.


murat.can@neziroglu.com.tr

TEÞEKKÜR EDERİM...!!!!!

 

[mehmett]

Forumda bu konuda bir çok örnek var Sn Murat Can. Aşağıdaki linki tıklarsanız örneklerden birini görebilirsiniz. Arama yaparsanız daha farklı örnekler de bulabilirsiniz.

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

 

[Necdet]

Sayın MURAT_CAN,

İddiayı kazanırsanız forum ailesine ne var?

 

[nziya]

Sayın zerige Ã?rnek linki vermiş ama buda bulunsun
'YTL FORMATINDA PARAYI YAZIYA ÇEVİRİR"=YAZIYACEVIR(A1)"(Yalnız Yüz YTL Yirmiüç YKr.)
Public Function YAZIYACEVIR(Para_Tutar)

Dim Para_TutarStr As String
Dim ParaBirimi As String, ParaAltBirimi As String

HücreAdı = Para_Tutar.Address

If Para_Tutar = "" Then
YAZIYACEVIR = HücreAdı & " Hücresine bir değer girmelisiniz !..."
Exit Function
End If

If Not IsNumeric(Para_Tutar) Then
YAZIYACEVIR = HücreAdı & " Hücresine girilen değer, sayı değil !..."
Exit Function
End If

ParaStr = Format(Abs(Para_Tutar), "0.00")
ParaBirimi = Left(ParaStr, Len(ParaStr) - 3)
ParaAltBirimi = Right(ParaStr, 2)

YAZIYACEVIR = IIf(Para_Tutar = 0, "Yalnız " & Cevir(ParaBirimi) & " YTL ", "") & _
IIf(Para_Tutar <> 0, "Yalnız ", "") & _
IIf(Para_Tutar < 0, "Eksi (-) ", "") & _
IIf(Para_Tutar <> 0, Cevir(ParaBirimi) & " YTL ", "") & _
IIf(Val(ParaAltBirimi) <> 0, Cevir(ParaAltBirimi) & " YKr.", "")

If ParaBirimi = 0 And ParaAltBirimi > 0 Then
YAZIYACEVIR = "Yalnız " & Cevir(ParaAltBirimi) & " YKr."

If Para_Tutar < 0 And ParaAltBirimi > 0 Then
YAZIYACEVIR = "Yalnız Eksi (-) " & Cevir(ParaAltBirimi) & " YKr."

End If

End If

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 = "Sıfır"

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

 

[suatsaner]

=YAZIYACEVİR(HÜCREADI)YAZIYORUM FAKAT İÞLEM GERÇEKLEÞMİYOR
BENİM İSTEDİÐİMDE YTL YOK.BANADA YARDIMCI OLABİLİRMİSİNİZ

 

[Fly_butterfly]

Bu konu daha önce cevaplanmıştı.. Aşağıdaki linkleri bir incele istersen.

http://www.excel.web.tr/viewtopic.php?t=11315 İng. ve Türkçe yazıya çeviriyor.

http://www.excel.web.tr/viewtopic.php?t=11348 YTL para birimini "Hücrelerini Biçimlendir"e ekliyor..

 

[MURAT_CAN]

ARKADAÞLAR İDDAA NIN SONUCU BELLİ OLDU BEN SARAR DAN TAKIM ELBİSEMİ ALDIM BİLE YANİ AMA BENİM Bİ ARKADAÞTAN BULDUM BU MAKROYU YİNE DE TEÞEKKÜR EDERİM HERKESE.... :

 

[numanmuhendiss]

Merhaba Arkadaşlar,

Rakamı Yazıya Çevirme formülü gerekiyor. Tabi Kuruşuna kadar.

Örnek; 1250,52 TL > #BinİkiYüzElli TL Elliiki Krş#

Bir kaç yerde buna benzer makrolar buldum ama tam olarak ihtiyacımı karşılamadı. İşimi bitirdiğimde kaydediyorum. Tekrar açtığımda formülü görmüyor. Makroyu nasıl kaydedebilirim? Yardımlarınızı rica ederim.

Dosyayı kaydetme sırasında gelen uyarı mesajı aşağıdadır.

Aşağıdaki özellikler makro içermeyen çalışma kitaplarına kaydedilemez:

* VB Projesi

Dosyayı bu özelliklerde kaydetmek için, Hayır'ı tıklatın ve ardından Dosya Türü listesinden makro özelliğini etkinleştirilmiş bir dosya türü seçin.

Makro içermeyen çalışma kitabı olarak kaydetmeye devam etmek için, Evet'i tıklatın.

 

[Trilenium]

Public Function YAZIYACEVIR(Para_Tutar)

Dim Para_TutarStr As String
Dim ParaBirimi As String, ParaAltBirimi As String

HücreAdı = Para_Tutar.Address

If Para_Tutar = "" Then
YAZIYACEVIR = HücreAdı & " Hücresine bir değer girmelisiniz !..."
Exit Function
End If

If Not IsNumeric(Para_Tutar) Then
YAZIYACEVIR = HücreAdı & " Hücresine girilen değer, sayı değil !..."
Exit Function
End If

ParaStr = Format(Abs(Para_Tutar), "0.00")
ParaBirimi = Left(ParaStr, Len(ParaStr) - 3)
ParaAltBirimi = Right(ParaStr, 2)

YAZIYACEVIR = IIf(Para_Tutar = 0, "Yalnız " & Cevir(ParaBirimi) & " TL ", "") & _
IIf(Para_Tutar <> 0, "Yalnız ", "") & _
IIf(Para_Tutar < 0, "Eksi (-) ", "") & _
IIf(Para_Tutar <> 0, Cevir(ParaBirimi) & " TL ", "") & _
IIf(Val(ParaAltBirimi) <> 0, Cevir(ParaAltBirimi) & " Kr.", "")

If ParaBirimi = 0 And ParaAltBirimi > 0 Then
YAZIYACEVIR = "Yalnız " & Cevir(ParaAltBirimi) & " Kr."

If Para_Tutar < 0 And ParaAltBirimi > 0 Then
YAZIYACEVIR = "Yalnız Eksi (-) " & Cevir(ParaAltBirimi) & " Kr."

End If

End If

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 = "Sıfır"

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


Yeni bir dosya açınız.
ALT+F11 tuşlayınız
Açılan sayfa da Sol Panelden Modüles bölümüne gelerek Module1 'e yukarı da vermiş olduğum kodu yapıştırınız.

Sayfayı kapatınız.
Dosya / Farklı Kaydet Seçiniz.
Açılan Pencere de
Excel 97-2003 XLA seçiniz..
Add-Ins Bölümüne "Cevir" veya "yazıyla" adında kaydediniz. (Size kalmis isterseniz baska isimle de kaydedebilirsiniz)
Dosyayı Kapatınız.
Yeni bir Excel açınız.
Dosya / Ayarlar bölümüne geliniz.
Eklentileri seçiniz.
En Aşağıdan GİT bölümüne Clickleyiniz.
Açılan Pencere de GÖZAT bölümüne clickleyerek biraz önce Add-Ins klasörüne Yazıyla veya Çevir adıyla kaydettiginiz adlı XLA dosyasınız seçiniz.

Tamam diyerek açılan pencereyi kapatınız.

Herhangi bir hücreye gelerek kuruşlu bir rakam yazınız ve ve boş bir hücreye tekrar gelerek
=YAZIYACEVIR(A1) * A1 rakamın bulunduğu hücredir. seçiniz bitti bu kadar.

Artık her yeni açtığınız Excel dosyasında fonksiyon çalışacaktır.

Kolay gelsin

 

[numanmuhendiss]

Trilenium

Adım adım açıklamanız ve emeğiniz için teşekkür ederim. Formül kaydettim sorunsuz çalışıyor.

 

[Trilenium]

Rica ederim, kolay gelsin.

 

[nafis]

Sn.Trilenium, formülün birkere kaydedip, herr excel sayfasında kullanılması çok güzel. Elinize emeğinize sağlık.
Teşekkürederim.
Saygılarımla.