ytl formatı

[puslukurt]

sevgili arkadaşlar aslında çıok basit ama kafam karıştı yapamadım
ytl formatını excellde hücreleri biçimlendir / isteğe göre biçimlendir kısmında bulamadım buraya nasıl bir kod yazmalıyımki bana değeri versin excel hücresine 501.256 yazıyor ama ytl formatına göre 5.012,56 yazması gerekir sayı formatıbı bilen arkadaşlardan rica ediyorum şimdiden teşekkürler

 

[TRABLUS]

Aşağıda ki link işinize yarıyabilir.


http://www.excel.web.tr/viewtopic.php?t=2236&highlight=ytl

 

[puslukurt]

sayın moderatör kodunu b yazverirseniz çok sevinirim gönderliğiniz link olmadı

 

[Levent Menteşoğlu]

Aşağıdaki linkten Microsoft'un YTL eklentisini yükleyin. Daha sonra hücre biçimlendirmede YTL biçimini göreceksiniz.

http://www.microsoft.com/downloads/details.aspx?FamilyId=C1B09489-0AEF-4F0A-AEE8-6C3191B809A0&displaylang=tr

 

[danersin]

http://www.microsoft.com/downloads/details.aspx?FamilyId=C1B09489-0AEF-4F0A-AEE8-6C3191B809A0&displaylang=tr

 

[nihatjeoloji]

Selam

buradan indirdim fakat. hüçre biçimlendir'de (TL) ve (TL Türkçe) var. (YTL)yok ne yapmam lazım

http://www.microsoft.com/downloads/details.aspx?FamilyId=C1B09489-0AEF-4F0A-AEE8-6C3191B809A0&displaylang=tr

 

[nihatjeoloji]

selam

5.061.447.762.709 TL

bu rakamı yeni YTL çevirebilirmisiniz

 

[Mahmut Bayram]

bunu deneyin
Function Yaziyla(Sayi#)

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$ = "": onda$ = ""

Say$ = Str$(Sayi#)
virgul% = InStr(1, Say$, ".")
If virgul% Then
Say$ = Right$(Say$, Len(Say$) - virgul%)
Select Case Len(Say$)
Case 6: onda$ = "milyonda"
Case 5: onda$ = "yüzbinde"
Case 4: onda$ = "onbinde"
Case 3: onda$ = "binde"
Case 2: onda$ = "yüzde"
Case 1: onda$ = "onda"
End Select
GoSub cevir

virgul2$ = " virgül " + onda$ + " " + cevap$
cevap$ = ""

Say$ = Str$(Sayi#)
Say$ = Left(Say$, virgul% - 1)
End If
GoSub cevir
'If cevap$ = "" And Mid$(Str$(Sayi#), 2, 1) = 0 Then cevap$ = "Sıfır"
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%
Return
End Function

 

[Mahmut Bayram]

Çok özür karıştırmışım aslı aşağıdakidir.
Function YAZIYLAYTL(sayi, Optional tür As Byte = 0)
'tür=0 YTL ve YKR
' 1 Yalnız YTL
' 2 Tam sayı ise yalnız YTL

Dim tam
Dim küsur As Byte
Dim syazi As String

If IsNumeric(sayi) And Len(Format(sayi)) < 16 Then
sayi = Int(sayi * 100) / 100
If sayi < 0 Then
syazi = "Eksi "
sayi = Abs(sayi)
End If
tam = Int(sayi)
küsur = (sayi - tam) * 100
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
YAZIYLAYTL = syazi
End Function

Function yçevir(csayi)
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 sayi As String
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 ")

sayi = Format(csayi)
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

 

[Mahmut Bayram]

yazıylaytl deyip adresi verin

 

[nihatjeoloji]

mükemmel syn mahmut_bayram
çok teşekkürler

 

[starmetin]

Aşağıdaki linkten Microsoft'un YTL eklentisini yükleyin. Daha sonra hücre biçimlendirmede YTL biçimini göreceksiniz.

http://www.microsoft.com/downloads/details.aspx?FamilyId=C1B09489-0AEF-4F0A-AEE8-6C3191B809A0&displaylang=tr

,
teşekkürler leventm :hey: