sayıyı yazıya çevirme hk.

[selim zan]

Arkadaşlar iki ayrı sütunda bulunan Ytl ve Ykr yi nasıl yazıya çevirebiliriz bilen arkadaşlar yazarsa memnun olurum.

 

[talatcd]

yzıyla ytl

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) = "İ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 = ""

'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.
YTL = " YTL , "
YKR = " YKR "

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

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

 

[talatcd]

=BİRLEÞTİR("Yukarıda yazılı ";" ";yaziyla(((TOPLA(O33))+((TOPLA(P33))/100)));" ";" bütçe gideri tahakkuk ettirilmiştir.Ã?denmesi/Mahsubu gerekir.")

formül bu bu formülü kendi formuna göre uyarla. Kolay gelsin

 

[selim zan]

Arkadaşlar teşekkür ederim.

 

[selim zan]

talatcd arkadaşım formülü yazdım ama olmadı o33 hanesine YTL yi P33 hanesinede YKR yi girdim ama almadı AD yazıyor nerde hata var acaba

 

[talatcd]

Selim bey dosyayı gönder yardımcı olmaya çalışayım.

 

[otufan03]

Sayın Leventm tarafından oluşturulmuş aşağıda yazılı fonksiyonu bilgisayarıma eklenti olarak yükledim. Bütün dosyalarda kullanıyorum,biç bir sorun yok.
A1 Hücresinde YTL B1 Hücresinde YKR var ise eğer C1 hücresine yazı ile yazdırmak istersen C1 hücresine =Yaz(A1;B1) yazıyorsun.
Function yaz$(ytl, ykr)
Dim aa(2)
Dim deg(2)
aa(1) = ytl
aa(2) = ykr
For zz = 1 To 2
sayi = aa(zz)
Dim b$(9)
Dim y$(9)
Dim m$(4)
Dim v$(15)
Dim c$(3)
b$(0) = ""
b$(1) = "BİR"
b$(2) = "İKİ"
b$(3) = "ÜÇ"
b$(4) = "DÃ?RT"
b$(5) = "BEÞ"
b$(6) = "ALTI"
b$(7) = "YEDİ"
b$(8) = "SEKİZ"
b$(9) = "DOKUZ"
y$(0) = ""
y$(1) = "ON"
y$(2) = "YİRMİ"
y$(3) = "OTUZ"
y$(4) = "KIRK"
y$(5) = "ELLİ"
y$(6) = "ALTMIÞ"
y$(7) = "YETMİÞ"
y$(8) = "SEKSEN"
y$(9) = "DOKSAN"
m$(0) = "TRILYON"
m$(1) = "MİLYAR"
m$(2) = "MİLYON"
m$(3) = "BİN"
m$(4) = ""
a$ = Str(sayi)
If Left$(a$, 1) = "" Then pozitif = 1 Else pozitif = 0
a$ = Right$(a$, Len(a$) - 1)
For x = 1 To Len(a$)
If (Asc(Mid$(a$, x, 1)) > Asc("9")) Or (Asc(Mid$(a$, x, 1)) < Asc("0")) Then GoTo hata
Next x
If Len(a$) > 15 Then GoTo hata
a$ = String(15 - Len(a$), "0") + a$
For x = 1 To 15
v(x) = Val(Mid$(a$, x, 1))
Next x
a$ = ""
For x = 0 To 4
c(1) = v((x * 3) + 1)
c(2) = v((x * 3) + 2)
c(3) = v((x * 3) + 3)
If c(1) = 0 Then
e$ = ""
ElseIf c(1) = 1 Then
e$ = "YÜZ"
Else
e$ = b$(c(1)) + "YÜZ"
End If
e$ = e$ + y$(c(2)) + b$(c(3))
If e$ <> "" Then e$ = e$ + m$(x)
If (x = 3) And (e$ = "BİRBİN") Then e$ = "BİN"
s$ = s$ + e$
Next x
If s$ = "" Then s$ = "SIFIR"
If pozitif = 0 Then s$ = "" + s$
deg(zz) = s$
GoTo tamam
hata: yaz$ = "hata"
tamam:
s$ = ""
Next
yaz$ = deg(1) & " YTL " & deg(2) & " YKR"
End Function

 

[selim zan]

talatcd arkadaşım dosya ekte yardımların için teşekkür ederim[/url][/list]

 

[Levent Menteşoğlu]

Sayın Leventm tarafından oluşturulmuş

Sn otufan03

Bir düzeltme yapmak istiyorum. Yazdığınız kod bana ait değildir.

 

[feza2]

arkadaşlar ben bu konuda yeniyim
bu formülleri nasılö kullanacağım nereye yazacağım
nasıl ekkin kılacağım yardımcı olursanız teşekkürler

 

[mehmett]

Sn feza2

Bu konuda yeni iseniz, nereden başlayacağınızı ve ne soracağınızı bilmiyorsanız şimdilik forumu sadece takip edin. Excel'e yeni Başlayanlar bölümü başta olmak üzere sorulan soruları ve gelen cevapları okuyun. Excel'de Bunları Biliyormuydunuz ve Excel Dersanesi gibi bölümlerini inceleyin. Zamanla soru soracak veya gelen sorulara cevap verecek duruma gelirsiniz.

 

[talatcd]

ytl nakit

selim bey dosya ekte

 

[otufan03]

Sayın Leventm 24 Ocak 2006 saat 21:30 de sizin fonksiyonlar bölümünde uyarladığınız bir dosya var,bahsettiğim konu o, ben ondan çok iyi yararlanıyorum,çok işime yaradı. Selamlar.

 

[selim zan]

talatc arkadaşım teşekkür ederim iyi çalışmalar :hey: