Skip to main content

AccessTr.neT


Excel hücrede sayısal değeri yazı ile gösterme

Excel hücrede sayısal değeri yazı ile gösterme

Çözüldü #5
Merhaba.

Bu konuda nette bir çok örnek mevcut.
Sıfırdan hazırlamaktansa elimde mevcut olan M.Temel Korkmaz'ın hazırladığı bir fonksiyonu burada paylaşayım.

Kod:
Function yaz$(sayi)
  Dim b$(9)
  Dim y$(9)
  Dim m$(4)
  Dim v(15)
  Dim c(3)

  b$(0) = ""
  b$(1) = "Bir"
  b$(2) = "İki"
  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(sayi)

  If Left$(a$, 1) = " " Then pozitif = 1 Else pozitif = 0
  a$ = Right$(a$, Len(a$) - 1)
  For x = 1 To Len(a$)
    If (Asc(Mid$(a$, x, 1)) > Asc("9")) Or (Asc(Mid$(a$, x, 1)) < Asc("0")) Then GoTo hata
  Next x

  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$

  yaz$ = s$
  GoTo tamam
hata: yaz$ = "Hata"
tamam:
End Function

Not: Sayın ogulcan92, mesajınızı benimkini post ettikten sonra gördüm.
Mesajlarımızı Türkçe yazım kurallarına uygun yazalım.
Emeğe saygı gösterelim, bir teşekkürü çok görmeyelim.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da

Bu Konudaki Yorumlar
Cvp: Acil yardım - Yazar: alpeki99 - 24/11/2009, 16:48
Cvp: Acil yardım - Yazar: sezginsasm - 24/11/2009, 17:10
Cvp: Excel için destek istiyorum - Yazar: sezginsasm - 24/11/2009, 19:01
Cvp: Excel için destek istiyorum - Yazar: maytas - 24/11/2009, 17:44
Cvp: Excel için destek istiyorum - Yazar: ogulcan92 - 24/11/2009, 17:59
Cvp: Excel için destek istiyorum - Yazar: sezginsasm - 25/11/2009, 10:35
Cvp: Excel için destek istiyorum - Yazar: maytas - 25/11/2009, 11:05
Cvp: Excel için destek istiyorum - Yazar: nihatkr - 24/11/2009, 18:54
Cvp: Excel için destek istiyorum - Yazar: sezginsasm - 24/11/2009, 19:06
Cvp: Excel için destek istiyorum - Yazar: ogulcan92 - 24/11/2009, 18:59
Cvp: Excel için destek istiyorum - Yazar: ogulcan92 - 24/11/2009, 19:05
Cvp: Excel için destek istiyorum - Yazar: nihatkr - 24/11/2009, 19:15
Cvp: Excel için destek istiyorum - Yazar: nihatkr - 25/11/2009, 11:25
Task