• Foruma hoş geldin 👋 Ziyaretçi

    Forum içeriğine ve tüm hizmetlerimize erişim sağlamak için foruma kayıt olmalı ya da giriş yapmalısınız. Foruma üye olmak tamamen ücretsizdir.

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

Durum
Konu Çözümlendiği İçin Kapatılmıştır.

Reus

Yeni Üye
Katılım
19 Ocak 2022
Mesajlar
6
Aldığı beğeni
6
Excel V
Office 365 TR
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.
 
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.

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)

1642623501801.png
 

Ekli dosyalar

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.
Eklediğim dosyada

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

Ekli dosyalar

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
 
Bi tanede ben paylaşıyım maşallah derya denizmiş
 

Ekli dosyalar

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
Teşekkür ederim.
 
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.
Teşekkür ederim. Yönteminizi çok beğendim. Elinize sağlık(y)(y)
 
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
Teşekkür ederim.
 
Durum
Konu Çözümlendiği İçin Kapatılmıştır.
Geri
Üst