yanlış hatırlamıyorsam Sn mehmett'in bu konu ile ilgili bir çalışması vardı.
eper zaman oldu, başlığı hatırlamıyorum. bir bakayım, bulabilirsem buraya linki yazarım.
Bir de burada bir kullanıcı tanımlı fonksiyon var.
Bunu .xla olarak ekleyip =yaz formülü şeklinde kullanabilirsiniz. Milyarlar dahil yazabiliyor. http://www.excel.web.tr/showthread.php?t=651
sn cobanoglu ekteki dosyayı örnek uygulamalar ve linkler bölümünde buldum. sn entropy tr hazırlamış. umarım işinize yarar. sn entropy tr ye çok teşekkürler.
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 YTL As String
Dim YKR As String
If Sayi# = 0 Then Yaziyla = "Sıfır": Exit Function
Say = Str$(Sayi#)
virgul = InStr(1, Say, ".")
If virgul Then
If Len(Mid(Say, virgul + 1)) = 1 Then Say = Say + "0"
Say = Right$(Say, Len(Say) - virgul)
GoSub cevir
If cevap = "" Then YKR = ""
virgul2 = cevap + YKR
cevap = ""
Say = Str$(Sayi#)
Say = Left$(Say, virgul - 1)
End If
GoSub cevir
If cevap = "" Then YTL = ""
Yaziyla = cevap + YTL + 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) = "bir" And i = 2 Then yazi = ""
cevap = yazi + basamak$(i) + cevap
End If
Next i
If Sayi# < 0 Then cevap = "-Eksi-" + cevap
Return
End Function
Sizlere daha iyi bir deneyim sunabilmek icin sitemizde çerez konumlandırmaktayız, web sitemizi kullanmaya devam ettiğinizde çerezler ile toplanan kişisel verileriniz Veri Politikamız / Bilgilendirmelerimizde belirtilen amaçlar ve yöntemlerle mevzuatına uygun olarak kullanılacaktır.