Sayısal Fiyatı Kelimelere Çevirmek

Merhaba.

Sayısal olarak verilen fiyatları kelimelere çevirmek için kodun bazı yerlerinde düzenleme yapılmıştır. Çünkü, orijinal kod çalışınca, "1000", "100" gibi sayılar, "Bir Bin", "Bir Yüz" olarak dönüşüyordu.

Kodu VBA düzenleyiciye yapıştırdıktan sonra, dosyayı, XSLM veya XLSB olarak kaydederseniz kod korunur.

Boş bir hücreye =Fiyati_Metne_Cevir(A1) işlevi yazarak fonksiyonu kullanabilirsiniz.

Option Explicit Function Fiyati_Metne_Cevir(ByVal MyNumber) Dim Dollars, Cents, Temp As String Dim DecimalPlace, Count ReDim Place(9) As String Place(2) = " Bin " Place(3) = " Milyon " Place(4) = " Milyar " Place(5) = " Trilyon " ' String representation of amount MyNumber = Trim(Str(MyNumber)) ' Position of decimal place 0 if none DecimalPlace = InStr(MyNumber, ".") 'Convert cents and set MyNumber to dollar amount If DecimalPlace > 0 Then Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)) MyNumber = Trim(Left(MyNumber, DecimalPlace - 1)) End If Count = 1 Do While MyNumber <> "" Temp = GetHundreds(Right(MyNumber, 3)) If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars If Len(MyNumber) > 3 Then MyNumber = Left(MyNumber, Len(MyNumber) - 3) Else MyNumber = "" End If Count = Count + 1 Loop Select Case Dollars Case "" Dollars = "Sıfır TL" Case "" Dollars = "Bir TL" Case Else Dollars = Dollars & " TL" End Select Select Case Cents Case "" Cents = "" Case "Bir" Cents = " ve Bir Kuruş" Case Else Cents = " ve " & Cents & " Kuruş" End Select If Dollars Like "Bir Bin*" Then Dollars = Replace(Dollars, "Bir Bin", "Bin") End If Dollars = Replace(Dollars, " ", " ") Fiyati_Metne_Cevir = Trim(Dollars & Cents) End Function ' Converts a number from 100-999 into text Private Function GetHundreds(ByVal MyNumber) Dim Result As String If Val(MyNumber) = 0 Then Exit Function MyNumber = Right("000" & MyNumber, 3) 'Convert the hundreds place If Mid(MyNumber, 1, 1) = "1" Then Result = "Yüz " End If If Mid(MyNumber, 1, 1) = "2" Then Result = GetDigit(Mid(MyNumber, 1, 1)) & " Yüz " End If If Mid(MyNumber, 1, 1) = "3" Then Result = GetDigit(Mid(MyNumber, 1, 1)) & " Yüz " End If If Mid(MyNumber, 1, 1) = "4" Then Result = GetDigit(Mid(MyNumber, 1, 1)) & " Yüz " End If If Mid(MyNumber, 1, 1) = "5" Then Result = GetDigit(Mid(MyNumber, 1, 1)) & " Yüz " End If If Mid(MyNumber, 1, 1) = "6" Then Result = GetDigit(Mid(MyNumber, 1, 1)) & " Yüz " End If If Mid(MyNumber, 1, 1) = "7" Then Result = GetDigit(Mid(MyNumber, 1, 1)) & " Yüz " End If If Mid(MyNumber, 1, 1) = "8" Then Result = GetDigit(Mid(MyNumber, 1, 1)) & " Yüz " End If If Mid(MyNumber, 1, 1) = "9" Then Result = GetDigit(Mid(MyNumber, 1, 1)) & " Yüz " End If 'Convert the tens and ones place If Mid(MyNumber, 2, 1) <> "0" Then Result = Result & GetTens(Mid(MyNumber, 2)) Else Result = Result & GetDigit(Mid(MyNumber, 3)) End If GetHundreds = Result End Function ' Converts a number from 10 to 99 into text. * Private Function GetTens(TensText) Dim Result As String Result = "" 'null out the temporary function value If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19 Select Case Val(TensText) Case 10: Result = "On" Case 11: Result = "On Bir" Case 12: Result = "On İki" Case 13: Result = "On Üç" Case 14: Result = "On Dört" Case 15: Result = "On Beş" Case 16: Result = "On Altı" Case 17: Result = "On Yedi" Case 18: Result = "On Sekiz" Case 19: Result = "On Dokuz" Case Else End Select Else ' If value between 20-99 Select Case Val(Left(TensText, 1)) Case 2: Result = "Yirmi " Case 3: Result = "Otuz " Case 4: Result = "Kırk " Case 5: Result = "Elli " Case 6: Result = "Altmış " Case 7: Result = "Yetmiş " Case 8: Result = "Seksen " Case 9: Result = "Doksan " Case Else End Select Result = Result & GetDigit _ (Right(TensText, 1)) 'Retrieve ones place End If GetTens = Result End Function ' Converts a number from 1 to 9 into text. Private Function GetDigit(Digit) Select Case Val(Digit) Case 1: GetDigit = "Bir" Case 2: GetDigit = "İki" Case 3: GetDigit = "Üç" Case 4: GetDigit = "Dört" Case 5: GetDigit = "Beş" Case 6: GetDigit = "Altı" Case 7: GetDigit = "Yedi" Case 8: GetDigit = "Sekiz" Case 9: GetDigit = "Dokuz" Case Else: GetDigit = "" End Select End Function 'Kaynak: https://www.excelforum.com/tips-and-tutorials/1015010-convert-a-numeric-value-to-words-without-vba.html 'Doğrudan link: https://www.excelforum.com/attachments/tips-and-tutorials/654676d1576780633-convert-a-numeric-value-to-words-without-vba-number_to_text.xlsm

Kaynak: https://www.excelforum.com/tips-and-tutorials/1015010-convert-a-numeric-value-to-words-without-vba.html
Doğrudan link: https://www.excelforum.com/attachments/tips-and-tutorials/654676d1576780633-convert-a-numeric-value-to-words-without-vba-number_to_text.xlsm