sayıyı rakama kuruşlu çevirmek Hazır Excel Makroları (VBA) | Excel Programları

Makroyu Kopyala

'Excel Makro (VBA) online eğitimleri için: https://www.excelsizeyeter.com/excelsizeyeter.com/udemy_giris.php adresine tıklayınız. Bir eğitim alana bir eğitim bedavadır. İkinci eğitim olarak Excel, Excel pratik çözümler, finans eğitimleri vb. alabilirsiniz.

Function ParaCevir(para As Double)
    If Not IsNumeric(sayi) Then GoTo Hata
    If (para - Int(para)) = 0 Then
        ParaCevir = cevir(para)
    Else
        tamsayi = cevir(Int(para))
        ondalik = cevir((para - Int(para)) * 100)
        ondalik = LCase(Mid(ondalik, 1, 1)) + Mid(ondalik, 2, Len(ondalik) - 1)
        ParaCevir = tamsayi + "virgül" + ondalik
    End If
    GoTo tamam
Hata:
    ParaCevir = "Hata"
tamam:
End Function
  
Private Function cevir(sayi As Double)
    
    Dim b(9) As String
    Dim y(9) As String
    Dim m(4) As String
    Dim v(15)
    Dim c(3)

b(0) = ""
    b(1) = "bir"
    b(2) = "iki"
    b(3) = "üç"
    b(4) = "dört"
    b(5) = "beş"
    b(6) = "altı"
    b(7) = "yedi"
    b(8) = "sekiz"
    b(9) = "dokuz"

y(0) = ""
    y(1) = "on"
    y(2) = "yirmi"
    y(3) = "otuz"
    y(4) = "kırk"
    y(5) = "elli"
    y(6) = "altmış"
    y(7) = "yetmiş"
    y(8) = "seksen"
    y(9) = "doksan"

m(0) = "trilyon"
    m(1) = "milyar"
    m(2) = "milyon"
    m(3) = "bin"
    m(4) = ""
    
    a = Str(Round(sayi, 0))
    If Left(a, 1) = " " Then pozitif = 1 Else pozitif = 0
    a = Right(a, Len(a) - 1)
        
    If Len(a) > 15 Then GoTo Hata
    a = String(15 - Len(a), "0") + a
    
    For x = 1 To 15
      v(x) = Val(Mid(a, x, 1))
    Next x
    
    s = ""
    For x = 0 To 4
      c(1) = v(x * 3 + 1)
      c(2) = v(x * 3 + 2)
      c(3) = v(x * 3 + 3)
      If c(1) = 0 Then
        e = ""
      ElseIf c(1) = 1 Then
        e = "yüz"
      Else
        e = b(c(1)) + "yüz"
      End If
      e = e + y(c(2)) + b(c(3))
      If e = "" Then e = e + m(x)
      If (x = 3) And (e = "birbin") Then e = "bin"
      s = s + e
    Next x

If s = "" Then s = "sıfır"
    If pozitif = 0 Then s = "eksi" + s

cevir = UCase(Mid(s, 1, 1)) + Mid(s, 2, Len(s) - 1)
End Function
Exit Sub
Hata:
   cevir = "HATA"
End Function

Benzer Sonuçlar
No	Makro Adı
1	sayıyı rakama kuruşlu çevirmek
2	rakamı / sayıyı İngilizce yazıya çevirmek (Dolar ve cent para birimi şeklinde)
3	Sayıyı / Rakamı Yazıya (Metne) Çevirme Fonksiyonu (Türkçe)
4	hücredeki sayıyı alt veya üst karaktere ve normale çevirir. h2o, co2
5	sayının karekökü
6	Yazı içerisinde geçen sayıları gösterme
7	İlk yazı karakterinden hemen önceki sayıyı tespit etmek
8	sayıyı dakika ve saniye cinsinden yazma
9	kırmızı renkli sayıyı seç g12 ye yazsın
10	sayfada renklendirilmesini istediğiniz sayıyı msgboxa yazınız
11	sayıyı dolar olarak okuma =dollartext(a1)
12	rakamı yazıya çevirme makrosu
13	hücredeki sayıyı bir üst binliğe tamamlar
14	Hücrelerde geçen en büyük sayıyı bulma / Bir alanda en büyük sayı hangisi
15	sayıyı paranteze alma örnek: 3- = (3) sayının yanına çizgi şart
16	hücredeki sayıyı bulma
17	excel sayfasında yazılanları texte çevirmek
18	hücredeki sayıyı kendi binliğine 0 sıfırlar
19	print (çıktı) alınmışsa sayıyı bir artır
20	verilen sayıyı gruplara bölme işlemi

Benzer Sonuçlar

Makro Adı

sayıyı rakama kuruşlu çevirmek

rakamı / sayıyı İngilizce yazıya çevirmek (Dolar ve cent para birimi şeklinde)

Sayıyı / Rakamı Yazıya (Metne) Çevirme Fonksiyonu (Türkçe)

hücredeki sayıyı alt veya üst karaktere ve normale çevirir. h2o, co2

sayının karekökü

Yazı içerisinde geçen sayıları gösterme

İlk yazı karakterinden hemen önceki sayıyı tespit etmek

sayıyı dakika ve saniye cinsinden yazma

kırmızı renkli sayıyı seç g12 ye yazsın

sayfada renklendirilmesini istediğiniz sayıyı msgboxa yazınız