• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Yukarı yuvarla

Katılım
28 Kasım 2007
Mesajlar
919
Excel Vers. ve Dili
Office 2010 İngilizce
Merhaba arkadaşlar,

Siteden bulduğu rakamı yazıya çevir makrosunu kullanıyorum. Rakamlarımı rounup yapıp yazıya çevirmesini istiyorum olmadı. Neden acaba yardımcı olabilir misiniz?
=YAZIYACEVIR(ROUNDUP(C5;0))
 

Ekli dosyalar

Merhaba arkadaşlar,

Siteden bulduğu rakamı yazıya çevir makrosunu kullanıyorum. Rakamlarımı rounup yapıp yazıya çevirmesini istiyorum olmadı. Neden acaba yardımcı olabilir misiniz?
=YAZIYACEVIR(ROUNDUP(C5;0))

Merhaba
Kod:
=YUKARIYUVARLA(YAZIYACEVIR(C4);0)
Kod:
=ROUNDUP(YAZIYACEVIR(C4);0)
Şeklinde dener misiniz_?
Bende 2007 mevcut bunda yazıyaçevir fonksiyonu var deniyemedim.
 
Olmadı :(( 2007 default mu varsa nerde ingilizce kullanıyorum. Rica etsem söyleyebilir misiniz?
 
Olmadı :(( 2007 default mu varsa nerde ingilizce kullanıyorum. Rica etsem söyleyebilir misiniz?

Yanlış farketmişim kodda bir problem var sanırım yuvarlamıyor
Module'deki kodları silin ve bu kodları yerine kopyalayın.
Kod:
Function Yaziyla(sayi#)
Dim TL As String
Dim KR As String
Dim i As Integer
Dim virgul1 As Integer
Dim virgul2 As String
Dim cevap As String
Dim yazi As String
Dim say As String
Dim deg1 As String
If sayi# = 0 Then Yaziyla = "": Exit Function
ReDim birler$(10), onlar$(10), basamak$(5)
birler$(0) = "":        birler$(1) = "bir"
birler$(2) = "iki":     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 = "": TL = ".TL.": KR = ".Krş."
say = Str$(sayi#)
virgul1 = InStr(1, say, ".")
If virgul1 Then
If Len(Mid(say, virgul1 + 1)) = 1 Then say = say + "0"
say = Right$(say, Len(say) - virgul1)
GoSub cevir
If cevap = "" Then KR = ""
virgul2 = cevap + KR
cevap = ""
say = Left$(Str$(sayi#), virgul1 - 1)
End If
GoSub cevir
If cevap = "" Then TL = ""
Yaziyla = WorksheetFunction.Proper(cevap) + TL + WorksheetFunction.Proper(virgul2)
Exit Function
cevir:
say = String$(3 - (Len(say) - Int(Len(say) / 3) * 3), 48) + say
For i = 1 To Len(say) / 3
deg1 = Mid$(say, Len(say) - i * 3 + 1, 3)
yazi = ""
If Val(Mid$(deg1, 1, 1)) <> 0 Then
If Val(Mid$(deg1, 1, 1)) > 1 Then yazi = birler$(Val(Mid$(deg1, 1, 1)))
yazi = yazi + "yüz"
End If
yazi = yazi + onlar$(Val(Mid$(deg1, 2, 1))) + birler$(Val(Mid$(deg1, 3, 1)))
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
Hücreye yazarkende
Kod:
=Yaziyla(YUKARIYUVARLA(C5;0))
Bu şekilde yazın.
Eki inceleyiniz
 

Ekli dosyalar

Geri
Üst