Muharrem DOĞANCI: Excel'de Sayıyı Yazıya Çevirmek

1 Mayıs 2022 Pazar

Excel'de Sayıyı Yazıya Çevirmek

Bunun için kaynağını henüz tespit edemediğim çok eski bir makroyu paylaşıyorum:

Function tl_yaz(sayi)
On Error Resume Next
Dim deg(3), s(3), deger(2)
a = Array("", "Bir", "İki", "Üç", "Dört", "Beş", "Altı", "Yedi", "Sekiz", "Dokuz")
b = Array("", "On", "Yirmi", "Otuz", "Kırk", "Elli", "Altmış", "Yetmiş", "Seksen", "Doksan")
c = Array("", "", "Bin", "Milyon", "Milyar", "Trilyon")
deger(1) = Int(sayi)
deger(2) = Round(sayi - deger(1), 2) * 100
If sayi = 0 Then son = "sıfır"
For g = 1 To 2
    yazi = deger(g)
    For d = 1 To Len(yazi) Step 3
        e = e + 1
        deg(1) = Mid(yazi, Len(yazi) - d - 1, 1)
        deg(2) = Mid(yazi, Len(yazi) - d, 1)
        deg(3) = Mid(yazi, Len(yazi) - d + 1, 1)
        If deg(1) <> 0 Then s(1) = Replace(a(deg(1)) & "Yüz", "BirYüz", "Yüz")
        s(2) = b(deg(2))
        s(3) = a(deg(3)) & c(e)
        If deg(1) + deg(2) + deg(3) = 0 Then s(3) = ""
        son = s(1) & s(2) & s(3) & son
        If Left(son, 6) = "BirBin" Then son = Replace(son, "BirBin", "Bin")
        For f = 1 To 3
            deg(f) = ""
            s(f) = ""
    Next: Next
    If g = 1 And deger(1) <> 0 Then tl = son & " TürkLirası"
    If g = 2 And deger(2) <> 0 Then kr = " " & son & " Kuruş"
    son = ""
    e = 0
Next
tl_yaz = tl & kr
End Function

Mehmet CANBULAT'ın yazdığı kod:
Detayları izlemeniz önerilir.
Kaynak: https://youtu.be/QgRtYX-bGzA

Option Explicit

Const d = 3

Public Function SayiyiCevir(ByVal inpNumber As Variant)

Application.Volatile

Dim SolTaraf As Variant
Dim SagTaraf As Variant
Dim Temp As Variant
Dim Ondalik As Variant
Dim Count As Variant
Dim inpNumberNew As Variant
Dim strFraction As Variant
Dim negBool As Variant

ReDim grupBasamak(5) As String

If Len(inpNumber) > d * UBound(grupBasamak) Then
    SayiyiCevir = "Cok Buyuk Sayi": Exit Function
End If
If inpNumber = "" Then SayiyiCevir = "": Exit Function
inpNumberNew = Round(inpNumber, 2)

grupBasamak(2) = " Bin "
grupBasamak(3) = " Milyon "
grupBasamak(4) = " Milyar "
grupBasamak(5) = " Trilyon "
grupBasamak(5) = " Katrilyon "

inpNumber = Trim(Str(inpNumber))
Ondalik = IIf(InStr(inpNumber, "+") = 0, InStr(inpNumber, "."), 0)

If Val(inpNumber) < 0 Then negBool = True: inpNumber = Abs(Val(inpNumber))

If Ondalik > 0 Then
    SagTaraf = OnlukBul(Left(Mid(inpNumber, Ondalik + 1) & "00", 2))
    strFraction = SagTaraf
    inpNumber = Trim(Left(inpNumber, Ondalik - 1))
End If

SagTaraf = inpNumber: Count = 1

Do While inpNumber <> ""
    Temp = YuzlukBul(Right(inpNumber, d))
    If Temp <> "" Then SolTaraf = Temp & grupBasamak(Count) & SolTaraf
    If Len(inpNumber) > d Then
        inpNumber = Left(inpNumber, Len(inpNumber) - d)
    Else
        inpNumber = ""
    End If
    Count = Count + 1
Loop

SayiyiCevir = IIf(Val(SagTaraf) = 0 And Not negBool, "Sifir", SolTaraf)
If InStr(inpNumberNew, Application.DecimalSeparator) > 0 Then
    SayiyiCevir = SayiyiCevir & " Lira " & strFraction & " Kurus" 'Para Birimini Burdan Degistirebilirsiniz.
    SayiyiCevir = IIf(negBool, "Eksi " & SayiyiCevir, SayiyiCevir) & " Lira" 'Para Birimini Burdan Degistirebilirsiniz.
Else
    SayiyiCevir = IIf(negBool, "Eksi " & SayiyiCevir, SayiyiCevir) & " Lira" 'Para Birimini Burdan Degistirebilirsiniz.
End If
SayiyiCevir = Replace(Trim(SayiyiCevir), "  ", " ")

End Function
Private Function YuzlukBul(ByVal yuzlukMetin)

Dim tmpStr As String

If Val(yuzlukMetin) = 0 Then Exit Function

yuzlukMetin = Right("000" & yuzlukMetin, 3)
If Mid(yuzlukMetin, 1, 1) <> "0" Then
    tmpStr = IIf(RakamBul(Mid(yuzlukMetin, 1, 1)) = "Bir", _
    " Yuz ", RakamBul(Mid(yuzlukMetin, 1, 1)) & " Yuz ")
End If
If Mid(yuzlukMetin, 2, 1) <> "0" Then
    tmpStr = tmpStr & OnlukBul(Mid(yuzlukMetin, 2))
Else
    tmpStr = tmpStr & RakamBul(Mid(yuzlukMetin, 3))
End If

YuzlukBul = tmpStr

End Function
Private Function OnlukBul(OnlukMetin)

Dim tmpStr As String

tmpStr = ""
If Val(Left(OnlukMetin, 1)) = 1 Then
    Select Case Val(OnlukMetin)
        Case 10: tmpStr = "On"
        Case 11: tmpStr = "Onbir"
        Case 12: tmpStr = "Oniki"
        Case 13: tmpStr = "Onuc"
        Case 14: tmpStr = "Ondort"
        Case 15: tmpStr = "Onbes"
        Case 16: tmpStr = "Onalti"
        Case 17: tmpStr = "Onyedi"
        Case 18: tmpStr = "Onsekiz"
        Case 19: tmpStr = "Ondokuz"
        Case Else
    End Select
Else
    Select Case Val(Left(OnlukMetin, 1))
        Case 2: tmpStr = "Yirmi "
        Case 3: tmpStr = "Otuz "
        Case 4: tmpStr = "Kirk "
        Case 5: tmpStr = "Elli "
        Case 6: tmpStr = "Altmis "
        Case 7: tmpStr = "Yetmis "
        Case 8: tmpStr = "Seksen "
        Case 9: tmpStr = "Doksan "
        Case Else
    End Select
    tmpStr = tmpStr & RakamBul(Right(OnlukMetin, 1))
End If

OnlukBul = tmpStr

End Function
Private Function RakamBul(Rakam)

Select Case Val(Rakam)
    Case 1: RakamBul = "Bir"
    Case 2: RakamBul = "Iki"
    Case 3: RakamBul = "Uc"
    Case 4: RakamBul = "Dort"
    Case 5: RakamBul = "Bes"
    Case 6: RakamBul = "Alti"
    Case 7: RakamBul = "Yedi"
    Case 8: RakamBul = "Sekiz"
    Case 9: RakamBul = "Dokuz"
    Case Else: RakamBul = ""
End Select

End Function

Google Tablolar için javascript kodu da şöyle:

function tl_yaz(number) {
  var units = ['', 'Bir', 'İki', 'Üç', 'Dört', 'Beş', 'Altı', 'Yedi', 'Sekiz', 'Dokuz'];
  var tens = ['', '', 'Yirmi', 'Otuz', 'Kırk', 'Elli', 'Altmış', 'Yetmiş', 'Seksen', 'Doksan'];
  var scales = ['', 'Bin', 'Milyon', 'Milyar'];

  number = parseFloat(number).toFixed(2);

  var numberParts = number.toString().split(".");
  var integerPart = parseInt(numberParts[0], 10);
  var decimalPart = parseInt(numberParts[1], 10);

  if (isNaN(integerPart)) return '';

  if (integerPart === 0) {
    return 'Sıfır TL';
  }

  var integerPartWords = '';
  var scaleIndex = 0;

  while (integerPart > 0) {
    var scale = scales[scaleIndex];
    var part = integerPart % 1000;
    integerPart = Math.floor(integerPart / 1000);

    var partWords = '';

    if (part > 0) {
      var hundreds = Math.floor(part / 100);
      var tensAndUnits = part % 100;

      if (hundreds > 0) {
        partWords += units[hundreds] + ' Yüz ';
      }

      if (tensAndUnits > 0) {
        if (tensAndUnits < 10) {
          partWords += units[tensAndUnits];
        } else if (tensAndUnits >= 10 && tensAndUnits < 20) {
          partWords += getTeenWords(tensAndUnits);
        } else {
          var tensIndex = Math.floor(tensAndUnits / 10);
          var unitsIndex = tensAndUnits % 10;

          partWords += tens[tensIndex];

          if (unitsIndex > 0) {
            partWords += ' ' + units[unitsIndex];
          }
        }
      }
    }

    if (partWords !== '') {
      if (scaleIndex > 0) {
        partWords += ' ' + scale;
      }

      if (integerPartWords !== '') {
        integerPartWords = partWords + ' ' + integerPartWords;
      } else {
        integerPartWords = partWords;
      }
    }

    scaleIndex++;
  }

  var decimalPartWords = '';

  if (decimalPart > 0) {
    if (decimalPart < 10) {
      decimalPartWords += units[decimalPart] + ' KR';
    } else if (decimalPart >= 10 && decimalPart < 20) {
      decimalPartWords += getTeenWords(decimalPart) +
      ' KR';
    } else {
      var tensIndex = Math.floor(decimalPart / 10);
      var unitsIndex = decimalPart % 10;

      decimalPartWords += tens[tensIndex];

      if (unitsIndex > 0) {
        decimalPartWords += ' ' + units[unitsIndex];
      }
      decimalPartWords += ' KR';
    }

  }

  var result = integerPartWords + ' TL';

  if (decimalPartWords !== '') {
    result += ' ' + decimalPartWords;
  }
  result = result.replace(/Bir Yüz/g,"Yüz"); //Birden fazla değişiklik yapabilmesi için Regular Expression yazım biçimi kullanılmıştır
  if (result.substring(0, 7) === 'Bir Bin') {
    result = result.replace("Bir Bin","Bin")
  }
  result = result.replace("Milyar Bir Bin","Milyar Bin")
  result = result.replace("Milyon Bir Bin","Milyon Bin")
  result = result.replace("  "," ");
  return result;
}

// Onluk sistemdeki sayıların okunuşlarını almak için kullanılan fonksiyon
function getTeenWords(number) {
  switch (number) {
  case 10:
  return 'On';
  case 11:
  return 'On Bir';
  case 12:
  return 'On İki';
  case 13:
  return 'On Üç';
  case 14:
  return 'On Dört';
  case 15:
  return 'On Beş';
  case 16:
  return 'On Altı';
  case 17:
  return 'On Yedi';
  case 18:
  return 'On Sekiz';
  case 19:
  return 'On Dokuz';
  default:
  return '';
  }
}

Muharrem DOĞANCI

Bu Blogda Ara

1 Mayıs 2022 Pazar

Excel'de Sayıyı Yazıya Çevirmek

Hiç yorum yok:

Yorum Gönder