Yazıyla makrosunda hata var?

[faceturk]

Bu makroda 1986 yazdımmı Birbindokuzyüzseksenaltı yazıyor nedeni ne olabilri
yardımcı olursanız sevinirim.

Function Yaziyla(Sayi#)
Dim virgul2 As String
Dim cevap As String
Dim yazi As String
Dim Say As String
Dim uclu As String
Dim virgul As Integer
Dim o As Integer
Dim b As Integer
Dim x As Integer
Dim i As Integer
Dim y As Integer
Dim TL As String
Dim Kr As String

If Sayi# = 0 Then Yaziyla = "sıfır": Exit Function

ReDim birler$(10), onlar$(10), basamak$(5)

birler$(0) = "": birler$(1) = "Bir"
birler$(2) = "İki": 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#)
virgul = InStr(1, Say, ".")
If virgul Then


If Len(Mid(Say, virgul + 1)) = 1 Then Say = Say + "0"

Say = Right$(Say, Len(Say) - virgul)
GoSub cevir

If cevap = "" Then Kr = ""
virgul2 = cevap + Kr
cevap = ""

Say = Str$(Sayi#)
Say = Left$(Say, virgul - 1)
End If
GoSub cevir
If cevap = "" Then TL = ""
Yaziyla = cevap + TL + virgul2
Exit Function

cevir:
x = Len(Say)
Say = String$(3 - (x - Int(x / 3) * 3), 48) + Say
x = Len(Say) / 3
For i = 1 To x
uclu = Mid$(Say, Len(Say) - i * 3 + 1, 3)
y = Val(Mid$(uclu, 1, 1))
o = Val(Mid$(uclu, 2, 1))
b = Val(Mid$(uclu, 3, 1))

yazi = ""
If y <> 0 Then
If y > 1 Then yazi = birler$
yazi = yazi + "Yüz"
End If

yazi = yazi + onlar$(o) + birler$(b)

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

 

[ocamsul]

Tekrar baktım da evet; Üsdadımın dediği gibi "BİRBİN" sorunu bu.

 

[Korhan Ayhan]

Selamlar,

Sanırım sıkıntınız "BirBin" yazması. Aşağıdaki linkte konuyla ilgili başka çalışmaları bulabilirsiniz. İncelermisiniz.

http://www.excel.web.tr/f116/


Yada kullanmış olduğunuz koda aşağıdaki kırmızı renkli eklemeyi yapıp deneyiniz.

Function Yaziyla(Sayi#)
Dim virgul2 As String
Dim cevap As String
Dim yazi As String
Dim Say As String
Dim uclu As String
Dim virgul As Integer
Dim o As Integer
Dim b As Integer
Dim x As Integer
Dim i As Integer
Dim y As Integer
Dim TL As String
Dim Kr As String
If Sayi# = 0 Then Yaziyla = "sıfır": Exit Function
ReDim birler$(10), onlar$(10), basamak$(5)
birler$(0) = "": birler$(1) = "Bir"
birler$(2) = "İki": 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#)
virgul = InStr(1, Say, ".")
If virgul Then

If Len(Mid(Say, virgul + 1)) = 1 Then Say = Say + "0"
Say = Right$(Say, Len(Say) - virgul)
GoSub cevir
If cevap = "" Then Kr = ""
virgul2 = cevap + Kr
cevap = ""
Say = Str$(Sayi#)
Say = Left$(Say, virgul - 1)
End If
GoSub cevir
If cevap = "" Then TL = ""
[COLOR=red]If Left(cevap, 6) = "BirBin" Then cevap = Mid(cevap, 4, 255)[/COLOR]
Yaziyla = cevap + TL + virgul2
Exit Function
cevir:
x = Len(Say)
Say = String$(3 - (x - Int(x / 3) * 3), 48) + Say
x = Len(Say) / 3
For i = 1 To x
uclu = Mid$(Say, Len(Say) - i * 3 + 1, 3)
y = Val(Mid$(uclu, 1, 1))
o = Val(Mid$(uclu, 2, 1))
b = Val(Mid$(uclu, 3, 1))
yazi = ""
If y <> 0 Then
If y > 1 Then yazi = birler$(y)
yazi = yazi + "Yüz"
End If
yazi = yazi + onlar$(o) + birler$(b)
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

 

[halit3]

Function Yaziyla(sayi#)
Dim virgul2 As String
Dim cevap As String
Dim yazi As String
Dim Say As String
Dim uclu As String
Dim virgul As Integer
Dim o As Integer
Dim b As Integer
Dim X As Integer
Dim i As Integer
Dim y As Integer
Dim TL As String
Dim KR 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#)
virgul = InStr(1, Say, ".")
If virgul Then
        
If Len(Mid(Say, virgul + 1)) = 1 Then Say = Say + "0"
Say = Right$(Say, Len(Say) - virgul)
GoSub cevir
        
If cevap = "" Then KR = ""
ker = Len(cevap)
ker1 = UCase(Mid(cevap, 1, 1))
If ker1 = "I" Then
ker1 = "İ"
End If
ker2 = Mid(cevap, 2, ker)
cevap = ker1 & ker2
    
virgul2 = cevap + KR
cevap = ""
        
Say = Str$(sayi#)
Say = Left$(Say, virgul - 1)
End If
GoSub cevir
If cevap = "" Then TL = ""
    
    
Yaziyla = cevap + TL + virgul2
ver = Len(Yaziyla)
ver1 = UCase(Mid(Yaziyla, 1, 1))
If ver1 = "I" Then
ver1 = "İ"
End If
ver2 = Mid(Yaziyla, 2, ver)
Yaziyla = ver1 & ver2
    
Exit Function
cevir:
X = Len(Say)
Say = String$(3 - (X - Int(X / 3) * 3), 48) + Say
X = Len(Say) / 3
For i = 1 To X
uclu = Mid$(Say, Len(Say) - i * 3 + 1, 3)
y = Val(Mid$(uclu, 1, 1))
o = Val(Mid$(uclu, 2, 1))
b = Val(Mid$(uclu, 3, 1))
yazi = ""
If y <> 0 Then
If y > 1 Then yazi = birler$(y)
yazi = yazi + "yüz"
End If
            
yazi = yazi + onlar$(o) + birler$(b)
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
     
ser = Len(cevap)
ser1 = UCase(Mid(cevap, 1, 1))
If ser1 = "I" Then
ser1 = "İ"
End If
ser2 = Mid(cevap, 2, ser)
cevap = "-Eksi-" + ser1 & ser2
    
End If
     Return
End Function

 

[faceturk]

teşekkürler halit3