Bir hücredeki sayıyı rakam rakam yazıya çevirme

[H3V3S]

Arkadaşlar şimdiden teşekkür ederim, A1 hücresinde "T1102-19CD45854" böyle bir veri var. Ben bu veriyi A2 hücresine büyük hafrlerle "T, BİR, BİR, SIFIR, İKİ, BİR, DOKUZ, C, D, DÖRT, BEŞ, SEKİZ, BEŞ, DÖRT" yazmasını istiyorum yardımcı olabilirmisiniz

 

[YUSUF44]

Aşağıdaki KTF kodlarını bir modüle ekleyin. A2 hücresinde aşağıdaki formül istediğiniz sonucu verecektir:

=yaz(A1)

Kodlar:

Function yaz(veri)
Set regexp = CreateObject("VBscript.RegExp")
regexp.Global = True
regexp.Pattern = "[^0-9A-Za-zĞÜŞİÖÇığüşöç]"

If veri <> "" Then
    veri = CStr(regexp.Replace(veri.Value, ""))
    For i = 1 To Len(veri)
        If Mid(veri, i, 1) = 0 Then
            a = "SIFIR"
        ElseIf Mid(veri, i, 1) = 1 Then
            a = "BİR"
        ElseIf Mid(veri, i, 1) = 2 Then
            a = "İKİ"
        ElseIf Mid(veri, i, 1) = 3 Then
            a = "ÜÇ"
        ElseIf Mid(veri, i, 1) = 4 Then
            a = "DÖRT"
        ElseIf Mid(veri, i, 1) = 5 Then
            a = "BEŞ"
        ElseIf Mid(veri, i, 1) = 6 Then
            a = "ALTI"
        ElseIf Mid(veri, i, 1) = 7 Then
            a = "YEDİ"
        ElseIf Mid(veri, i, 1) = 8 Then
            a = "SEKİZ"
        ElseIf Mid(veri, i, 1) = 9 Then
            a = "DOKUZ"
        Else
            a = UCase(Mid(veri, i, 1))
        End If
        If yaz = "" Then
            yaz = a
        Else
            yaz = yaz & ", " & a
        End If
    Next
End If

End Function

 

[Haluk]

Yusuf Bey, pardon ama ..... bu fonksiyonda "RegExp" ne işe yarıyor ?

.

 

[YUSUF44]

Harf ve rakam dışındakileri gözardı etmek için kullandım, başka bir yol aklıma gelmedi.

 

[veyselemre]

Alternatif;

Function rakamlariYaziyaCevir(metin)
    For i = 1 To Len(metin)
        k = Mid(metin, i, 1)
        Select Case k
            Case 0 To 9
                k = Choose(k + 1, "SIFIR", "BİR", "İKİ", "ÜÇ", "DÖRT", _
                           "BEŞ", "ALTI", "YEDİ", "SEKİZ", "DOKUZ")
                br = br & ", " & k
            Case "A" To "Z"
                br = br & ", " & k
        End Select
    Next i
    rakamlariYaziyaCevir = Mid(br, 3)
End Function

 

[Haluk]

Türkçe karakterler de varsa, Veysel Beyin fonksiyonunu aşağıdaki gibi kullanabilriz;

Function rakamlariYaziyaCevir(metin)
    For i = 1 To Len(metin)
        k = Mid(metin, i, 1)
        Select Case k
            Case 0 To 9
                k = Choose(k + 1, "SIFIR", "BİR", "İKİ", "ÜÇ", "DÖRT", _
                           "BEŞ", "ALTI", "YEDİ", "SEKİZ", "DOKUZ")
            Case "-", "?", "!", "~", "+", " " 'Burasi gelistirilebilir...
                GoTo 10:
        End Select
        br = br & ", " & k
10:
    Next i
    rakamlariYaziyaCevir = Mid(br, 3)
End Function

.

 

[H3V3S]

Hocam elinize sağlık çalıştı güzelce teşekkür ederim

 

[H3V3S]

Alternatif;

Function rakamlariYaziyaCevir(metin)
    For i = 1 To Len(metin)
        k = Mid(metin, i, 1)
        Select Case k
            Case 0 To 9
                k = Choose(k + 1, "SIFIR", "BİR", "İKİ", "ÜÇ", "DÖRT", _
                           "BEŞ", "ALTI", "YEDİ", "SEKİZ", "DOKUZ")
                br = br & ", " & k
            Case "A" To "Z"
                br = br & ", " & k
        End Select
    Next i
    rakamlariYaziyaCevir = Mid(br, 3)
End Function

Hocam elinize sağlık bu biraz daha sade olmuş türkçe karakteri desteklemiyor onuda haluk bey alternatif olarak yazmış emeğiniz için teşekkür ederim

 

[Korhan Ayhan]

Bu da alternatif olsun.

Kullanım şekli;

=YAZIYA_ÇEVİR(A1) 'Verileri ", " (virgül boşluk) sembolü ile birleştirir. Sayıları yazıya çevirir. Varsayılan ayıraç budur. Tüm metin büyük harfe dönüşür.
=YAZIYA_ÇEVİR(A1,"-") 'Verileri tire sembolü ile birleştirir. Sayıları yazıya çevirir. Tüm metin büyük harfe dönüşür.
=YAZIYA_ÇEVİR(A1,"+") 'Verileri artı sembolü ile birleştirir. Sayıları yazıya çevirir. Tüm metin büyük harfe dönüşür.

Bu şekilde dilediğiniz ayıracı kullanarak verileri yazıya çevirip birleştirebilirsiniz.

Option Explicit

Function YAZIYA_ÇEVİR(Veri As Range, Optional Ayıraç As String = ", ")
    Dim Rakam As Variant, Karakter As Variant
    Dim Karakterler As Variant, Say As Long
    
    Application.Volatile True
    
    Rakam = Array("SIFIR", "BİR", "İKİ", "ÜÇ", "DÖRT", "BEŞ", "ALTI", "YEDİ", "SEKİZ", "DOKUZ")
    
    ReDim Liste(1 To 1)
    
    With CreateObject("VbScript.RegExp")
        .Pattern = "."
        .Global = True
        If .Test(Veri.Value) Then
            Set Karakterler = .Execute(Veri.Value)
            For Each Karakter In Karakterler
                If Karakter <> "-" Then
                    Say = Say + 1
                    ReDim Preserve Liste(1 To Say)
                    
                    If Not Karakter Like "[0-9]" Then
                        Liste(Say) = UCase(Replace(Replace(Karakter, "ı", "I"), "i", "İ"))
                    Else
                        Liste(Say) = Rakam(Karakter)
                    End If
                End If
            Next
        End If
    End With
    
    YAZIYA_ÇEVİR = Join(Liste, Ayıraç)
End Function