Arşiv Sayıyı Lira ve kuruşlu olarak yazıya çevirme

Reus' Alıntı:

Arkadaşlar merhaba.
Fatura toplamını (12,62 TL) yazıya (Oniki Lira Altmışiki Kuruş) nasıl çevirebilirim. Yardımlarınız için Teşekkürler.

Genişletmek için tıkla...

Function tl_yaz(sayi)
On Error Resume Next
Dim deg(3), s(3), deger(2)
a = Array("", "Bir", "İki", "Üç", "Dört", "Beş", "Altı", "Yedi", "Sekiz", "Dokuz")
b = Array("", "On", "Yirmi", "Otuz", "Kırk", "Elli", "Altmış", "Yetmiş", "Seksen", "Doksan")
c = Array("", "", "Bin", "Milyon", "Milyar", "Trilyon")
deger(1) = Int(sayi)
deger(2) = Round(sayi - deger(1), 2) * 100
If sayi = 0 Then son = "sıfır"
For g = 1 To 2
yazi = deger(g)
For d = 1 To Len(yazi) Step 3
e = e + 1
deg(1) = Mid(yazi, Len(yazi) - d - 1, 1)
deg(2) = Mid(yazi, Len(yazi) - d, 1)
deg(3) = Mid(yazi, Len(yazi) - d + 1, 1)
If deg(1) <> 0 Then s(1) = Replace(a(deg(1)) & "Yüz", "BirYüz", "Yüz")
s(2) = b(deg(2))
s(3) = a(deg(3)) & c(e)
If deg(1) + deg(2) + deg(3) = 0 Then s(3) = ""
son = s(1) & s(2) & s(3) & son
If Left(son, 6) = "BirBin" Then son = Replace(son, "BirBin", "Bin")
For f = 1 To 3
deg(f) = ""
s(f) = ""
Next: Next
If g = 1 And deger(1) <> 0 Then tl = son & " TürkLirası"
If g = 2 And deger(2) <> 0 Then kr = " " & son & " Kuruş"
son = ""
e = 0
Next
tl_yaz = tl & kr
End Function

=tl_yaz(A1)

Reus' Alıntı:

Arkadaşlar merhaba.
Fatura toplamını (12,62 TL) yazıya (Oniki Lira Altmışiki Kuruş) nasıl çevirebilirim. Yardımlarınız için Teşekkürler.

Genişletmek için tıkla...

himmgarip' Alıntı:

Ekte örnek mevcut. Aşağıdaki kodu modüle ekleyin.

Kod:

Function tl_yaz(sayi)
On Error Resume Next
Dim deg(3), s(3), deger(2)
a = Array("", "Bir", "İki", "Üç", "Dört", "Beş", "Altı", "Yedi", "Sekiz", "Dokuz")
b = Array("", "On", "Yirmi", "Otuz", "Kırk", "Elli", "Altmış", "Yetmiş", "Seksen", "Doksan")
c = Array("", "", "Bin", "Milyon", "Milyar", "Trilyon")
deger(1) = Int(sayi)
deger(2) = Round(sayi - deger(1), 2) * 100
If sayi = 0 Then son = "sıfır"
For g = 1 To 2
yazi = deger(g)
For d = 1 To Len(yazi) Step 3
e = e + 1
deg(1) = Mid(yazi, Len(yazi) - d - 1, 1)
deg(2) = Mid(yazi, Len(yazi) - d, 1)
deg(3) = Mid(yazi, Len(yazi) - d + 1, 1)
If deg(1) <> 0 Then s(1) = Replace(a(deg(1)) & "Yüz", "BirYüz", "Yüz")
s(2) = b(deg(2))
s(3) = a(deg(3)) & c(e)
If deg(1) + deg(2) + deg(3) = 0 Then s(3) = ""
son = s(1) & s(2) & s(3) & son
If Left(son, 6) = "BirBin" Then son = Replace(son, "BirBin", "Bin")
For f = 1 To 3
deg(f) = ""
s(f) = ""
Next: Next
If g = 1 And deger(1) <> 0 Then tl = son & " TürkLirası"
If g = 2 And deger(2) <> 0 Then kr = " " & son & " Kuruş"
son = ""
e = 0
Next
tl_yaz = tl & kr
End Function

Hangi hücrede yazı olarak görmek isiyorsanız;

Örneğin A1 hücresinde rakam var. B1 hücresinde yazı olarak görmek istiyorsunuz.

B1 hücresine aşağıdaki formülü yazın.

Kod:

=tl_yaz(A1)

Ekli dosyayı görüntüle 4997

Genişletmek için tıkla...

tanrisever_37' Alıntı:

Kod olmadan normal dosya ile çalışmak isterseniz farklı bir çalışma olarak sunmak istedim.
Sayfa1 i kendi dosyanıza kopyalayıp ilgili başvuruları yaparak kullanabilirisniz.

Genişletmek için tıkla...

askan' Alıntı:

Bi tanede ben paylaşıyım maşallah derya denizmiş

Genişletmek için tıkla...

halily' Alıntı:

alternatif)

Kod:

Function Sayi_Metin(SayiStr As String) As String
If Len(SayiStr & "") = 0 Then Exit Function
Dim BolDizi As Variant, BolukDizi As Variant
Dim Itm As Variant

SayiStr = Format(SayiStr, "0,000.###")
Virgul = Split(SayiStr, ",")(1)
SayiStr = Split(SayiStr, ",")(0)

If Len(SayiStr & "") > 18 Then
    SayiStr = Right(SayiStr, 18)
End If

BolDizi = Split(SayiStr, ".")
i = UBound(BolDizi) + 1
ReDim BolukDizi(1 To i)

    For Each Itm In BolDizi
        BolukDizi(i) = Itm
        i = i - 1
    Next Itm
   
Boluk = 1
    For Each Itm In BolukDizi
        If Itm > 0 Then Sayi_Metin = Basamak(Format(Itm, "000")) & Choose(Boluk, "", " BİN", " MİLYON", " MİLYAR", " TRİLYON", " KATTRİLYON") & Sayi_Metin
        If Itm = 1 Then Sayi_Metin = Replace(Sayi_Metin, "BİR BİN", "BİN")
        Boluk = Boluk + 1
    Next Itm
    Virgul = Basamak(Format(Virgul, "000"))
    Sayi_Metin = IIf(Trim(Sayi_Metin) <> "", Trim(Sayi_Metin) & " Lira", "") & IIf(Virgul <> "", " " & Virgul & " Kuruş", "")

End Function

Kod:

Function Basamak(ByVal BasamakStr As String) As String

Basamak = ""
If Len(BasamakStr & "") = 0 Then Exit Function
    If Mid(BasamakStr, 3, 1) > 0 Then x1 = Choose(Mid(BasamakStr, 3, 1), " BİR", " İKİ", " ÜÇ", " DÖRT", " BEŞ", " ALTI", " YEDİ", " SEKİZ", " DOKUZ")
    If Mid(BasamakStr, 2, 1) > 0 Then x2 = Choose(Mid(BasamakStr, 2, 1), " ON", " YİRMİ", " OTUZ", " KIRK", " ELLİ", " ALTMIŞ", " YETMİŞ", " SEKSEN", " DOKSAN")
    If Mid(BasamakStr, 1, 1) > 0 Then x3 = Choose(Mid(BasamakStr, 1, 1), "", " İKİ", " ÜÇ", " DÖRT", " BEŞ", " ALTI", " YEDİ", " SEKİZ", " DOKUZ") & " YÜZ"
    Basamak = x3 & x2 & x1
End Function

Genişletmek için tıkla...

KFonx' Alıntı:

Eklediğim dosyada

=ParaCevir(Yazıya çevrilecek hücre) formülü ile yapabilirsiniz.

Genişletmek için tıkla...