-
DİKKAT DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Çok eski bir web tarayıcısı kullanıyorsunuz. Bu veya diğer siteleri görüntülemekte sorunlar yaşayabilirsiniz..
Tarayıcınızı güncellemeli veya alternatif bir tarayıcı kullanmalısınız.
Tarayıcınızı güncellemeli veya alternatif bir tarayıcı kullanmalısınız.
Rakamı Çevirme
- Konbuyu başlatan emreunalp
- Başlangıç tarihi
Option Explicit
Function YAZ(sayi As Currency, Optional tür As Byte = 0)
Dim tam$
Dim küsur$
Dim syazi As String
Dim v As Byte, s$
If IsNumeric(sayi) And Len(Format(Int(sayi))) < 16 Then
If sayi < 0 Then
syazi = "Eksi "
sayi = Abs(sayi)
End If
s = Format(sayi)
v = InStr(s, ",")
'If v = 0 Then v = InStr(s, ".")
If v <> 0 Then
tam = Left(s, v - 1)
küsur = Left(Mid(s, v + 1, 2) & "0", 2)
Else
tam = s
küsur = "0"
End If
syazi = syazi & yçevir(tam) & " YTL "
If tür = 0 Or (tür = 2 And küsur <> 0) Then
syazi = syazi & yçevir(küsur) & " YKr"
End If
Else
syazi = "Hata"
End If
YAZ = syazi
End Function
Function yçevir(sayi As String)
Dim birler, onlar, bsayi
Dim rakamlar(1 To 15) As Byte
Dim yazi As String, syazi As String
Dim uz As Byte
Dim m
Dim bs As Byte
Dim art As Byte
Dim rakam As Byte
birler = Array("", "Bir", "İki", "Üç", "Dört", "Beş", "Altı", "Yedi", "Sekiz", "Dokuz")
onlar = Array("", "On", "Yirmi", "Otuz", "Kırk", "Elli", "Altmış", "Yetmiş", "Seksen", "Doksan")
bsayi = Array("", "Bin ", "Milyon ", "Milyar ", "Trilyon ")
uz = Len(sayi)
For m = uz To 1 Step -1
art = art + 1
rakamlar(art) = Val(Mid(sayi, m, 1))
Next
For bs = 1 To uz
art = bs Mod 3
rakam = rakamlar(bs)
yazi = ""
Select Case art
Case 1
yazi = birler(rakam) & bsayi(Int(bs / 3))
If uz = 4 And yazi = "BirBin " Then yazi = "Bin "
Case 2
yazi = onlar(rakam)
Case 0
If rakam = 0 Then
yazi = ""
ElseIf rakam = 1 Then
yazi = "Yüz"
Else
yazi = birler(rakam) & "Yüz"
End If
End Select
syazi = yazi & syazi
Next
If syazi = "" Then
syazi = "Sıfır"
Else
syazi = Replace(syazi, " Bin ", "")
syazi = Replace(syazi, " Milyar ", "")
syazi = Replace(syazi, " Milyon ", "")
End If
yçevir = syazi
End Function
bu kodları bir modül içerisine yerleştirin.
yeni bir fonksiyon oluşacak.
fonksiyon kullanımı şöyle
=YAZ(buraya yazıya çevrilmek istenen rakamın adresini yazacaksınız A1 gibi.)
=YAZ(A1) gibi.
Function YAZ(sayi As Currency, Optional tür As Byte = 0)
Dim tam$
Dim küsur$
Dim syazi As String
Dim v As Byte, s$
If IsNumeric(sayi) And Len(Format(Int(sayi))) < 16 Then
If sayi < 0 Then
syazi = "Eksi "
sayi = Abs(sayi)
End If
s = Format(sayi)
v = InStr(s, ",")
'If v = 0 Then v = InStr(s, ".")
If v <> 0 Then
tam = Left(s, v - 1)
küsur = Left(Mid(s, v + 1, 2) & "0", 2)
Else
tam = s
küsur = "0"
End If
syazi = syazi & yçevir(tam) & " YTL "
If tür = 0 Or (tür = 2 And küsur <> 0) Then
syazi = syazi & yçevir(küsur) & " YKr"
End If
Else
syazi = "Hata"
End If
YAZ = syazi
End Function
Function yçevir(sayi As String)
Dim birler, onlar, bsayi
Dim rakamlar(1 To 15) As Byte
Dim yazi As String, syazi As String
Dim uz As Byte
Dim m
Dim bs As Byte
Dim art As Byte
Dim rakam As Byte
birler = Array("", "Bir", "İki", "Üç", "Dört", "Beş", "Altı", "Yedi", "Sekiz", "Dokuz")
onlar = Array("", "On", "Yirmi", "Otuz", "Kırk", "Elli", "Altmış", "Yetmiş", "Seksen", "Doksan")
bsayi = Array("", "Bin ", "Milyon ", "Milyar ", "Trilyon ")
uz = Len(sayi)
For m = uz To 1 Step -1
art = art + 1
rakamlar(art) = Val(Mid(sayi, m, 1))
Next
For bs = 1 To uz
art = bs Mod 3
rakam = rakamlar(bs)
yazi = ""
Select Case art
Case 1
yazi = birler(rakam) & bsayi(Int(bs / 3))
If uz = 4 And yazi = "BirBin " Then yazi = "Bin "
Case 2
yazi = onlar(rakam)
Case 0
If rakam = 0 Then
yazi = ""
ElseIf rakam = 1 Then
yazi = "Yüz"
Else
yazi = birler(rakam) & "Yüz"
End If
End Select
syazi = yazi & syazi
Next
If syazi = "" Then
syazi = "Sıfır"
Else
syazi = Replace(syazi, " Bin ", "")
syazi = Replace(syazi, " Milyar ", "")
syazi = Replace(syazi, " Milyon ", "")
End If
yçevir = syazi
End Function
bu kodları bir modül içerisine yerleştirin.
yeni bir fonksiyon oluşacak.
fonksiyon kullanımı şöyle
=YAZ(buraya yazıya çevrilmek istenen rakamın adresini yazacaksınız A1 gibi.)
=YAZ(A1) gibi.
Valla aynı şey banada lazım oldu.Excel'i çok iyi bildiğim söylenemez ama denilenleri yaptım.YAZ fonksiyonu da çıktı ama yazıya çeviremedim.
Bana tam olarak;
Diyelim iki yada daha fazla sayıyı toplayıp sonuç hücresine sonucu yazıyla yazan bir fonk lazım.Çeklerde olduğu gibi.Az vaktim var malum ödev.Yardımcı olursanız sevinirim
Bana tam olarak;
Diyelim iki yada daha fazla sayıyı toplayıp sonuç hücresine sonucu yazıyla yazan bir fonk lazım.Çeklerde olduğu gibi.Az vaktim var malum ödev.Yardımcı olursanız sevinirim
- Katılım
- 13 Ekim 2004
- Mesajlar
- 16,060
- Excel Vers. ve Dili
- Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
bu kodları bir modül içerisine yerleştirin.
yeni bir fonksiyon oluşacak.
fonksiyon kullanımı şöyle
=YAZ(buraya yazıya çevrilmek istenen rakamın adresini yazacaksınız A1 gibi.)
=YAZ(A1) gibi.
Buraya kadar anlayıp yaptı iseniz,( A1 + B1 = C1 ) işlemi için D1 hüçresine =yaz(C1) şeklinde
Veya C1 hücresine =yaz(A1+B1) Şeklinde uygulayınız.
Sadece not almak içinse bu yeter. Öğrenmek istiyorum diyorsan Sn leventm vermiş olduğu adresi iyice inceleyin. Adresi önceden görmüş olsa idim bu cevabı göndermezdim.
Son düzenleme:
-
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.