Skip to main content

AccessTr.neT


hafta sonu için ekders

hafta sonu için ekders

Çözüldü #11
Aşağıdaki kodu Modül içerisine yapıştır. Sonra boş bir hücrede =yazıyla(hücre adresi) yaz

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

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

birler$(0) = "": birler$(1) = "bir"
birler$(2) = "iki": 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 = ""

'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.


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

'Aşağadaki satır 26,4 Yirmialtı YTL, KIRK YKR olarak okutur.
' (Yirmialtı YTL, DÖRT YKR 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



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
If Sayi# < 0 Then cevap = "-Eksi-" + cevap
Return
End Function
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da

Bu Konudaki Yorumlar
hafta sonu için ekders - Yazar: salihkk - 31/07/2013, 00:18
Cvp: hafta sonu için ekders - Yazar: maytas - 31/07/2013, 01:32
Cvp: hafta sonu için ekders - Yazar: salihkk - 31/07/2013, 02:18
Cvp: hafta sonu için ekders - Yazar: maytas - 31/07/2013, 02:23
Cvp: hafta sonu için ekders - Yazar: salihkk - 31/07/2013, 23:38
Cvp: hafta sonu için ekders - Yazar: maytas - 01/08/2013, 00:24
Cvp: hafta sonu için ekders - Yazar: salihkk - 01/08/2013, 00:34
Cvp: hafta sonu için ekders - Yazar: maytas - 01/08/2013, 00:35
Cvp: hafta sonu için ekders - Yazar: salihkk - 01/08/2013, 00:39
Cvp: hafta sonu için ekders - Yazar: salihkk - 31/08/2013, 22:50
Cvp: hafta sonu için ekders - Yazar: ynlmz - 01/09/2013, 00:39
Cvp: hafta sonu için ekders - Yazar: salihkk - 02/09/2013, 00:36
Cvp: hafta sonu için ekders - Yazar: ynlmz - 02/09/2013, 15:46
Cvp: hafta sonu için ekders - Yazar: ynlmz - 03/09/2013, 01:21
Task