Sayıyı metne çevirme

[BilalGungor]

Merhaba arkadaşlar

0,1 ile 99,9 arasındaki sayıları metne çevirebilecek bir formul arıyorum. Mesela A1 Hücresinde 0,1 yazınca metin şeklinde "sıfır tam onda bir" yazacak yada gene A1 hücresine 58,3 yazınca "elli sekiz tam onda üç" şeklinde yazı verecek. Bütün olay A1 hücresi ile B1 hücresi arasında olacak. Bu türden bir formül mümkün mü?

Teşekkürler

 

[Levent Menteşoğlu]

Bunun için en güzel çözüm vba dan istifade ederek kullanıcı tanımlı bir fonksiyon oluşturmaktır. Böyle bir çözüm işinize yararmı? Tek bir fonksiyon tanımlayarak çözüm üretmek mümkün değildir. Eğer hazır fonksiyonlarla bir çözüm düşünüyorsanız aşağıdaki linki inceleyin.

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

 

[Levent Menteşoğlu]

Ekte tamamen hazır fonksiyonlarla yapılmış bir örnek sunuyorum.

 

[Levent Menteşoğlu]

Yukarıdaki örnekteki bir hata düzeltilerek ek yenilenmiştir.

 

[Ali]

Sayın Levent Bey 16,38'i onaltı tam onda 3 diye okuyor acaba bunu tam olarak onaltı tam yüzde otuz sekiz diye okuyabilirmi.

 

[Levent Menteşoğlu]

Soru sadece 0,1-99,9 aralığı için sorulduğundan bu şekilde formülize etmiştim. Ama istediğinizde formüle bir ilave ile yapılabilir.

 

[Ali]

Levent Bey verdiğiniz bu örnek excel sayfasını xla olarak kaydedilip add-ins klasörüne eklenerek fonksiyon olarak kullanmak mümkünmüdür.

 

[Levent Menteşoğlu]

Hayır değildir. Fakat kullanıcı tanımlı bir fonksiyon oluşturulursa eklenti olarak kullanabilirsiniz. Bu durumda da vba devreye girer.

 

[Necdet]

Aşağıdaki Kodu biryerlerden bulmuştum ama nerden bulduğumu anımsamıyorum. Doğru çalışıyor ancak 0,15 gibi sayılarda Sıfır tam .... demiyor, onu da ustalara bırakıyorum.

Function Yaziyla(Sayi#)

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

birler$(0) = "": birler$(1) = "Bir"
birler$(2) = "İki": birler$(3) = "Üç"
birler$(4) = "Dört": birler$(5) = "Beş"
birler$(6) = "Altı": birler$(7) = "Yedi"
birler$(8) = "Sekiz": birler$(9) = "Dokuz"

onlar$(0) = "": onlar$(1) = "On"
onlar$(2) = "Yirmi": onlar$(3) = "Otuz"
onlar$(4) = "Kırk": onlar$(5) = "Elli"
onlar$(6) = "Altmış": onlar$(7) = "Yetmiş"
onlar$(8) = "Seksen": onlar$(9) = "Doksan"

basamak$(1) = "": basamak$(2) = "Bin"
basamak$(3) = "Milyon": basamak$(4) = "Milyar"
basamak$(5) = "Trilyon"

virgul2$ = "": cevap$ = "": onda$ = ""

Say$ = Str$(Sayi#)
virgul% = InStr(1, Say$, ".")
If virgul% Then
Say$ = Right$(Say$, Len(Say$) - virgul%)
Select Case Len(Say$)
Case 6: onda$ = "Milyonda"
Case 5: onda$ = "Yüzbinde"
Case 4: onda$ = "Onbinde"
Case 3: onda$ = "Binde"
Case 2: onda$ = "Yüzde"
Case 1: onda$ = "Onda"
End Select
GoSub cevir

virgul2$ = "Tam " + onda$ + " " + cevap$
cevap$ = ""

Say$ = Str$(Sayi#)
Say$ = Left(Say$, virgul% - 1)
End If
GoSub cevir
Yaziyla = cevap$ + 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$(y%)
yazi$ = yazi$ + "Yüz"
End If

yazi$ = yazi$ + onlar$(O%) + birler$(b%)

If yazi$ <> "" Then
If LCase(yazi$) = "bir" And i% = 2 Then yazi$ = ""
cevap$ = yazi$ + basamak$(i%) + cevap$
End If
Next i%
Return
End Function

 

[BilalGungor]

Teşekkürler

Tekrar merhaba arkadaşlar;

Leventm arkadaşımıza teşekkür ederim. Hazırladığı dosya fazlasıyla işimi gördü. Tekrar ilginize teşekkür ederim.

Selamlar...

 

[Necdet]

veee bende hala bekliyorum verdiğim kodda sıfır değerini göstermesi için

 

[Levent Menteşoğlu]

Sn Necdet bey

Kodda kırmızı renkle belirtilen satır ilave edilmiştir.

[vb:1:5784c4e74e]Function Yaziyla(Sayi#)

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

birler$(0) = "": birler$(1) = "Bir"
birler$(2) = "İki": birler$(3) = "Üç"
birler$(4) = "Dört": birler$(5) = "Beş"
birler$(6) = "Altı": birler$(7) = "Yedi"
birler$(8) = "Sekiz": birler$(9) = "Dokuz"

onlar$(0) = "": onlar$(1) = "On"
onlar$(2) = "Yirmi": onlar$(3) = "Otuz"
onlar$(4) = "Kırk": onlar$(5) = "Elli"
onlar$(6) = "Altmış": onlar$(7) = "Yetmiş"
onlar$(8) = "Seksen": onlar$(9) = "Doksan"

basamak$(1) = "": basamak$(2) = "Bin"
basamak$(3) = "Milyon": basamak$(4) = "Milyar"
basamak$(5) = "Trilyon"

virgul2$ = "": cevap$ = "": onda$ = ""

Say$ = Str$(Sayi#)
virgul% = InStr(1, Say$, ".")
If virgul% Then
Say$ = Right$(Say$, Len(Say$) - virgul%)
Select Case Len(Say$)
Case 6: onda$ = "Milyonda"
Case 5: onda$ = "Yüzbinde"
Case 4: onda$ = "Onbinde"
Case 3: onda$ = "Binde"
Case 2: onda$ = "Yüzde"
Case 1: onda$ = "Onda"
End Select
GoSub cevir

virgul2$ = " Tam " + onda$ + " " + cevap$
cevap$ = ""

Say$ = Str$(Sayi#)
Say$ = Left(Say$, virgul% - 1)
End If
GoSub cevir

If cevap$ = "" Then cevap$ = "Sıfır"

Yaziyla = cevap$ + 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$(y%)
yazi$ = yazi$ + "Yüz"
End If

yazi$ = yazi$ + onlar$(O%) + birler$(b%)

If yazi$ <> "" Then
If LCase(yazi$) = "bir" And i% = 2 Then yazi$ = ""
cevap$ = yazi$ + basamak$(i%) + cevap$
End If
Next i%
Return
End Function

[/vb:1:5784c4e74e]

 

[abazya]

Re: Yazıyı metne çevirme

0,1 ile 99,9 arasındaki sayıları metne çevirebilecek bir formul arıyorum.

Sn: BilalGüngör başlığıda konuya yakın olarak değiştirirseniz başka bir zaman lazım olupta arar iken çok faydası olacağına inanıyorum

( Yazıyı metne çevirme )

 

[Necdet]

Sayın levent Bey ,
Ben o kadar aradım uygun yeri bulamamıştım, Teşekkürler

 

[LEVTEPE]

ÃÇ ÃÇE ÇOK SAYIDA EÐER

A B
1 0,2 =EÐER(A1=0,1;"0 TAM ONDA BİR";EÐER(A1=0,2;"0 TAM ONDA İKİ";DOLAYLI("B2")))
2 =EÐER(A1=1,1;"BİR TAM ONDA BİR";EÐER(A1=1,2;"BİR TAM ONDA İKİ";DOLAYLI("B3")))

B1 DE İÇ İÇE 7 ADET EÐER FONKSİYONU KULLANABİLİRSİNİZ (Ã?RNEKDE 2 ADET). FORMÜLÜN SONUNDA DOLAYLI ("B2") İLE EÐER FONKSİYONUNUN DEVAMININ ALINACAÐI ADRESİ YAZARAK İSTEDİÐİNİZ KADAR EÐER EKLEYEBİLİRSİNİZ

AYRICA SAYIYI METNE ÇEVİRME İLE DE EÐERSİZ BU SORUNU HALLEDEBİLİRSİNİZ. (YÜZDE.XLS)