Sayıyı yazıya cevırme ?

C

cherkesburaktagay

Katılım
9 Ocak 2009
Mesajlar
9
Excel Vers. ve Dili
sadsadsa
Örneğin Ben Faturada Toplamı 400,00 TL olan yazıyı Alt satırda otomatik olarak DörtyüzTL olarak yazmasını istiyorum yardımcı olurmusunuz?
 
E

ersoyalan

Katılım
10 Nisan 2008
Mesajlar
578
Excel Vers. ve Dili
2000,2003,2007
Merhaba,

Ekli dosyayı inceleyin.Yada verinizin A1 hücresinde olduğunu düşünürsek A2 hücresine =tl(A2) formülünü yapıştırın.

E.ALAN
 

Ekli dosyalar

A

acolkesen1

Katılım
5 Aralık 2007
Mesajlar
635
Excel Vers. ve Dili
Office 2007
Altın Üyelik Bitiş Tarihi
08-05-2021
Sayın ersoyalan,
ahsensoft a ait ekenti sizin dosyanızda değil, yanlışlıktan dolayı özür dilerim..
 
mhaluksen

mhaluksen

Altın Üye
Katılım
27 Ocak 2006
Mesajlar
205
Excel Vers. ve Dili
ofis 2010- Türkçe
Altın Üyelik Bitiş Tarihi
25-06-2026
Kuruşu ayrı olan TL.yi yazıya çevirme

sayın değerli arkadaşlarım sizden yardım istiyorum.ekli dosyadaki F47 (TL) ile J47 (KRŞ) yi nasıl birleştirebiliriz.Yardımlarınızı bekliyorum.
 

Ekli dosyalar

E

Erhan Köseoğlu

Katılım
31 Aralık 2007
Mesajlar
227
Excel Vers. ve Dili
Office 2007 Türkçe
Altın Üyelik Bitiş Tarihi
16-10-2019
istediğinizi yaptım ancak çok küçük bir eksiği kaldı, şimdi çıkmam lazım geldiğimde hemen eklerim
 
P

parametre

Destek Ekibi
Destek Ekibi
Katılım
28 Ocak 2007
Mesajlar
1,585
Excel Vers. ve Dili
ofis 2010 turkce
bir kod yaziyorum
Function yaz$(sayi)
Dim b$(9)
Dim y$(9)
Dim m$(4)
Dim v$(15)
Dim c$(3)
b$(0) = ""
b$(1) = "BİR"
b$(2) = "İKİ"
b$(3) = "ÜÇ"
b$(4) = "DÖRT"
b$(5) = "BEŞ"
b$(6) = "ALTI"
b$(7) = "YEDİ"
b$(8) = "SEKİZ"
b$(9) = "DOKUZ"
y$(0) = ""
y$(1) = "ON"
y$(2) = "YİRMİ"
y$(3) = "OTUZ"
y$(4) = "KIRK"
y$(5) = "ELLİ"
y$(6) = "ALTMIŞ"
y$(7) = "YETMİŞ"
y$(8) = "SEKSEN"
y$(9) = "DOKSAN"
m$(0) = "TRILYON"
m$(1) = "MİLYAR"
m$(2) = "MİLYON"
m$(3) = "BİN"
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
a$ = ""
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$ = "BİRBİN") Then e$ = "BİN"
s$ = s$ + e$
Next x
If s$ = "" Then s$ = "SIFIR"
If pozitif = 0 Then s$ = "" + s$
yaz$ = s$
GoTo tamam
hata: yaz$ = "hata"
tamam:
End Function

buda

tlye ceviren program

Public Function ParaCevir(Para)
Dim ParaStr As String
Dim TL As String, Kurus As String

If Not IsNumeric(Para) Then GoTo SayiDegil

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

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

ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(TL) & " TL " & Cevir(Kurus) & " KR_"

Exit Function

SayiDegil:
ParaCevir = "GİRİLEN DEĞER SAYI DEĞİL!"
End Function

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

Birler = Array("", "BİR", "İKİ", "ÜÇ", "DÖRT", "BEŞ", "ALTI", "YEDİ", "SEKİZ", "DOKUZ")
Onlar = Array("", "ON", "YİRMİ", "OTUZ", "KIRK", "ELLİ", "ALTMIŞ", "YETMİŞ", "SEKSEN", "DOKSAN")
Binler = Array("TRİLYON", "MİLYAR", "MİLYON", "BİN", "")

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 = "BİRBİN") Then e = "BİN"
Sonuc = Sonuc + e
Next i

If Sonuc = "" Then Sonuc = "SIFIR"
Genişletmek için tıkla ...
 
P

parametre

Destek Ekibi
Destek Ekibi
Katılım
28 Ocak 2007
Mesajlar
1,585
Excel Vers. ve Dili
ofis 2010 turkce
burada iki kod var verilen biri saece rakamı yazıyor digeri yazılan rakama tl kurus ifadesi ekliyor bunlari seeneklerden yeni makro ekle deyip kodun adını yazacaksın ornegin yaz gibi cıkan sayfada bunları ekleyp kayıtedeceksin oradan cıkıp kodunu =yaz[ucre adı) seklinde yazarsan işlemn gerceklestigini goreceksiniz kolay gelsin
 
C

cherkesburaktagay

Katılım
9 Ocak 2009
Mesajlar
9
Excel Vers. ve Dili
sadsadsa
parametre' Alıntı:
bir kod yaziyorum
Genişletmek için tıkla ...
BU KODU NEREYE YAPISTIRICAZ

Function yaz$(sayi)
Dim b$(9)
Dim y$(9)
Dim m$(4)
Dim v$(15)
Dim c$(3)
b$(0) = ""
b$(1) = "BİR"
b$(2) = "İKİ"
b$(3) = "ÜÇ"
b$(4) = "DÖRT"
b$(5) = "BEŞ"
b$(6) = "ALTI"
b$(7) = "YEDİ"
b$(8) = "SEKİZ"
b$(9) = "DOKUZ"
y$(0) = ""
y$(1) = "ON"
y$(2) = "YİRMİ"
y$(3) = "OTUZ"
y$(4) = "KIRK"
y$(5) = "ELLİ"
y$(6) = "ALTMIŞ"
y$(7) = "YETMİŞ"
y$(8) = "SEKSEN"
y$(9) = "DOKSAN"
m$(0) = "TRILYON"
m$(1) = "MİLYAR"
m$(2) = "MİLYON"
m$(3) = "BİN"
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
a$ = ""
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$ = "BİRBİN") Then e$ = "BİN"
s$ = s$ + e$
Next x
If s$ = "" Then s$ = "SIFIR"
If pozitif = 0 Then s$ = "" + s$
yaz$ = s$
GoTo tamam
hata: yaz$ = "hata"
tamam:
End Function

buda

tlye ceviren program

Public Function ParaCevir(Para)
Dim ParaStr As String
Dim TL As String, Kurus As String

If Not IsNumeric(Para) Then GoTo SayiDegil

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

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

ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(TL) & " TL " & Cevir(Kurus) & " KR_"

Exit Function

SayiDegil:
ParaCevir = "GİRİLEN DEĞER SAYI DEĞİL!"
End Function

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

Birler = Array("", "BİR", "İKİ", "ÜÇ", "DÖRT", "BEŞ", "ALTI", "YEDİ", "SEKİZ", "DOKUZ")
Onlar = Array("", "ON", "YİRMİ", "OTUZ", "KIRK", "ELLİ", "ALTMIŞ", "YETMİŞ", "SEKSEN", "DOKSAN")
Binler = Array("TRİLYON", "MİLYAR", "MİLYON", "BİN", "")

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 = "BİRBİN") Then e = "BİN"
Sonuc = Sonuc + e
Next i

If Sonuc = "" Then Sonuc = "SIFIR"
 
P

parametre

Destek Ekibi
Destek Ekibi
Katılım
28 Ocak 2007
Mesajlar
1,585
Excel Vers. ve Dili
ofis 2010 turkce
ekteki dosyayı indir onu kullanırsınız kolay gelsin
 

Ekli dosyalar

M

Mx@Raid

Katılım
7 Ağustos 2007
Mesajlar
328
Excel Vers. ve Dili
excell 2003 - 2007
Kardeş basit bir çözüm ürettim uzman arkadaşlar geliştirirse daha iyi olur.
 

Ekli dosyalar

Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Üst