• DİKKAT

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

Exel 2007 de Parayı metne çevirme formülü

  • Konbuyu başlatan Konbuyu başlatan ural66
  • Başlangıç tarihi Başlangıç tarihi
U

ural66

Katılım
15 Ekim 2009
Mesajlar
52
Excel Vers. ve Dili
2021 TR
Selam arkadaşlar. Aşağıdaki VBA kodunu Exel 2007 de uyguluyorum hata veriyor çalışmıyor. Ama 2003 de hiç sıkıntısız çalışıyor.. Yardımcı olur musunuz..


Option Explicit

Function ParaCevir(Para, Optional PBirim = "Lira", Optional KBirim = "Kuruş")
Dim ParaStr As String
Dim Lira As String, Kurus As String

If Not IsNumeric(Para) Then
ParaCevir = "GİRİLEN DEĞER SAYI DEĞİL!"
Exit Function
End If

ParaStr = Format(Abs(Para), "0.00")

Lira = Left(ParaStr, Len(ParaStr) - 3)
Kurus = Right(ParaStr, 2)

ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & " " & PBirim & " " & _
IIf(Val(Kurus) <> 0, Cevir(Kurus) & " " & KBirim & " ", "")
End Function

Private Function Cevir(SayiStr As String) As String
Dim Rakam(15)
Dim c(3), Sonuc, e

Birler = Array("", "bir", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz")
Onlar = Array("", "on", "yirmi", "otuz", "kırk", "elli", "altmış", "yetmiş", "seksen", "doksan")
Binler = Array("trilyon", "milyar", "milyon", "bin", "")

SayiStr = String(15 - Len(SayiStr), "0") + SayiStr

For i = 1 To 15
Rakam(i) = Val(Mid$(SayiStr, i, 1))
Next i

Sonuc = ""
For i = 0 To 4
c(1) = Rakam(i * 3 + 1)
c(2) = Rakam(i * 3 + 2)
c(3) = Rakam(i * 3 + 3)
If c(1) = 0 Then
e = ""
ElseIf c(1) = 1 Then
e = "yüz"
Else
e = Birler(c(1)) + "yüz"
End If
e = e + Onlar(c(2)) + Birler(c(3))
If e <> "" Then e = e + Binler(i)
If (i = 3) And (e = "birbin") Then e = "bin"
Sonuc = Sonuc + e
Next i

If Sonuc = "" Then Sonuc = "Sıfır"

Cevir = UCase(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1)
End Function
 
Private Function Cevir(SayiStr As String) As StringBu satır sarı oluyor.. >Makro güvenliğini en düşük ayarladım ama bu exel 2007 yi bu yüzden hiç sevemedim. lütfen yardım.
 
merhaba

Option Explicit

satırını silin.
 
Merhaba,

aşağıdaki fonksiyonu da kullanabilirsiniz.

modül olarak ekleyiniz ve =yaziyacevir(ilgili hücre) olarak kullanabilirsiniz. hem 2007 hemde 2010 da sorunsuz çalışıyor.

Kod: 
Function yaziyacevir(rakam)
Dim grup(5), sayi(10, 3), basamak(5), oku(3)
sayi(0, 1) = "": sayi(0, 2) = "": sayi(0, 3) = ""
sayi(1, 1) = "YÜZ": sayi(1, 2) = "ON": sayi(1, 3) = "BİR"
sayi(2, 1) = "İKİYÜZ": sayi(2, 2) = "YİRMİ": sayi(2, 3) = "İKİ"
sayi(3, 1) = "ÜÇYÜZ": sayi(3, 2) = "OTUZ": sayi(3, 3) = "ÜÇ"
sayi(4, 1) = "DÖRTYÜZ": sayi(4, 2) = "KIRK": sayi(4, 3) = "DÖRT"
sayi(5, 1) = "BEŞYÜZ": sayi(5, 2) = "ELLİ": sayi(5, 3) = "BEŞ"
sayi(6, 1) = "ALTIYÜZ": sayi(6, 2) = "ALTMIŞ": sayi(6, 3) = "ALTI"
sayi(7, 1) = "YEDİYÜZ": sayi(7, 2) = "YETMİŞ": sayi(7, 3) = "YEDİ"
sayi(8, 1) = "SEKİZYÜZ": sayi(8, 2) = "SEKSEN": sayi(8, 3) = "SEKİZ"
sayi(9, 1) = "DOKUZYÜZ": sayi(9, 2) = "DOKSAN": sayi(9, 3) = "DOKUZ"
basamak(5) = "TRİLYON"
basamak(4) = "MİLYAR"
basamak(3) = "MİLYON"
basamak(2) = "BİN"
basamak(1) = ""
lira = Int(rakam)
kurus = Round(rakam - lira, 2) * 100
If Len(lira) > 15 Then
MsgBox ("Bu fonksiyon en fazla 15 haneli sayılar için çalışır.")
End
End If
kalan = lira
yaziyacevir = ""
 
For x = 1 To 5
a = 15 - 3 * x
  If Len(lira) > a Then
  grup(6 - x) = Int(kalan / 10 ^ a)
  kalan = kalan - (grup(6 - x) * 10 ^ a)
End If
 
Next x
 
If grup(5) > 0 Then
  oku(1) = Int(grup(5) / 100)
  baskalan = grup(5) - oku(1) * 100
  oku(2) = Int(baskalan / 10)
  oku(3) = baskalan - oku(2) * 10
  yaziyacevir = sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(5)
End If
 
If grup(4) > 0 Then
  oku(1) = Int(grup(4) / 100)
  baskalan = grup(4) - oku(1) * 100
  oku(2) = Int(baskalan / 10)
  oku(3) = baskalan - oku(2) * 10
  yaziyacevir = yaziyacevir + sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(4)
End If
 
If grup(3) > 0 Then
  oku(1) = Int(grup(3) / 100)
  baskalan = grup(3) - oku(1) * 100
  oku(2) = Int(baskalan / 10)
  oku(3) = baskalan - oku(2) * 10
  yaziyacevir = yaziyacevir + sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(3)
End If
 
If grup(2) = 1 Then
     yaziyacevir = yaziyacevir + "BİN"
End If
  
If grup(2) > 1 Then
  oku(1) = Int(grup(2) / 100)
  baskalan = grup(2) - oku(1) * 100
  oku(2) = Int(baskalan / 10)
  oku(3) = baskalan - oku(2) * 10
  yaziyacevir = yaziyacevir + sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(2)
End If
 
If grup(1) > 0 Then
  oku(1) = Int(grup(1) / 100)
  baskalan = grup(1) - oku(1) * 100
  oku(2) = Int(baskalan / 10)
  oku(3) = baskalan - oku(2) * 10
  yaziyacevir = yaziyacevir + sayi(oku(1), 1) + sayi(oku(2), 2) + sayi(oku(3), 3) + basamak(1)
End If
  yaziyacevir = yaziyacevir + "TÜRKLİRASI"
  If kurus > 0 Then
     oku(2) = 0
     If Len(kurus) > 1 Then
     oku(2) = Int(kurus / 10)
     End If
     oku(3) = kurus - oku(2) * 10
     yaziyacevir = yaziyacevir + sayi(oku(2), 2) + sayi(oku(3), 3) + "KURUŞ."
   End If
End Function
 
Arkadaşlar bi problemim daha oldu. Bu kodların bulunduğu exel formunu paylaştırıp 2. pc de de kullanıyorum ana pc de normal ama 2. pc de hala hata veriyor acaba neden. Exel ayarları iki pc de de aynı..
 
Formu nasıl paylaştırdığınızı anlamadım ama belli ki diğeri hala eski kodu içeren "kullanıcı tanımlı fonksiyonu" görüyor. Bu kodu sadece bir dosyaya modül olarak ekledi iseniz, kodu içeren dosyaların hepsinde değiştirmelisiniz.
Bence en iyi çözüm, bu KTF'yi boş bir dosyaya ilave ederek, xlam (excel eklentisi) olarak kaydedip, daha sonra her makinedeki excel de, excel seçeneklerinden eklenti olarak ilave etmek. Böylece yeni, eski her dosyada bu KTF'yi kullanabilirsiniz. Kullanacağınız her dosyada bu kodlara gerek kalmaz o zaman.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst