Your name in "Japanese"

Leandroarb

Board Regular
Joined
Oct 7, 2014
Messages
157
Hello everyone, These days I got a picture with letters and their syllables to form so your name in "Japanese". From there I rode this simple function to automate this using arrays and For-Next loops. Maybe you can think "useless", but I believe that idleness is very productive and in those moments you create several good things.Copy and paste the code below into a new module, type your name in a cell type and function in the cell sheet informing you wrote your name.Function NomeJapa(rng As Range) As StringDim strLetras As VariantDim strSilabas As VariantDim strNome As StringDim x As ByteDim y As ByteDim intCont As IntegerDim strNomeJapones As StringstrNome = LCase(rng)intCont = 0strLetras = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z")strSilabas = Array("ka", "tu", "mi", "te", "ku", "lu", "ji", "ri", "ki", "zu", "me", "ta", "rin", "to", "mo", "no", "ke", "shi", "ari", "chi", "do", "ru", "mei", "na", "fu", "ra")For x = 0 To Len(strNome)intCont = intCont + 1 For y = 0 To UBound(strLetras) If strLetras(y) = Mid(strNome, intCont, 1) Then strNomeJapones = strNomeJapones & strSilabas(y) & " " End If Next yNext xNomeJapa = strNomeJaponesEnd Function
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Hello

This is equivalent but less looping and less typing:

Code:
Function NomeJapa(rng As Range) As String

    Dim strSilabas As Variant
    Dim sChar As String
    Dim strNome As String
    Dim x As Byte
    Dim strNomeJapones As String

    strNome = LCase(rng)
    strSilabas = Array("ka", "tu", "mi", "te", "ku", "lu", "ji", "ri", "ki", "zu", "me", "ta", "rin", "to", "mo", "no", "ke", "shi", "ari", "chi", "do", "ru", "mei", "na", "fu", "ra")

    For x = 1 To Len(strNome)
        sChar = Mid(strNome, x, 1)
        If Asc(sChar) > 96 And Asc(sChar) < 123 Then
            strNomeJapones = strNomeJapones & strSilabas(Asc(sChar) - 97) & " "
        End If
    Next
    NomeJapa = Trim(strNomeJapones)

End Function
 
Upvote 0
This is equivalent but less looping and less typing:
If it is less typing you are after, here is your function pared down somewhat by removing two variable, changing the argument for the function (so it can be used as a UDF or be called from other VB code), converting the Array function call to a Split function call and simplifying the If..Then test...
Code:
Function NomeJapa(ByVal S As String) As String

    Dim strSilabas As Variant
    Dim sChar As String
    Dim x As Byte

    S = LCase(S)
    strSilabas = Split("ka tu mi te ku lu ji ri ki zu me ta rin to mo no ke shi ari chi do ru mei na fu ra")
    For x = 1 To Len(S)
        sChar = Mid(S, x, 1)
        If sChar Like "[a-z]" Then NomeJapa = NomeJapa & strSilabas(Asc(sChar) - 97) & " "
    Next
    NomeJapa = RTrim(NomeJapa)

End Function
 
Upvote 0
Arigato Mr. Shikimime Shimochiriarichikukito! :cool:
You are quite welcome, but the "I like compact code" driving force within me made me keep looking at this and I have reduced it by two code lines and one variable. In addition, I allow and retain a space if the name has one (if that was the wrong thing to do, let me know and I'll correct the code). Examples of this are the these two names...

Mary Anne
Della Rossa

I worked with two individuals, one with that first and the other with that last name.
Code:
  Dim x As Long, sChar As String
  Const Japan = " ??ka?tu?mi?te?ku?lu?ji?ri?ki?zu?me?ta?rinto?mo?no?ke?shiarichido?ru?meina?fu?ra"
  For x = 1 To Len(S)
    sChar = Replace(Mid(LCase(S), x, 1), " ", "`")
    If sChar Like "[`-z]" Then NomeJapa = NomeJapa & Replace(Mid(Japan, 3 * Asc(sChar) - 287, 3), "?", "")
  Next
End Function
 
Upvote 0
Maybe they'll do one of these for VBA, Rick. You'd be a shoo-in!
 
Last edited by a moderator:
Upvote 0
Mr. Rick, sorry for my joke was not offensive in any way.
Just pasted your code in my spreadsheet and performed with his name, I hope I have not been insolent.
About your code, sure it is clear and easy to understand.
I am just an ordinary worker here in Brazil, my background is in the construction field as a coach, so my codes are written very extensive and naively.
But thankfully I found this forum with trained and experienced members like you.

Best regards
 
Upvote 0
I worked with two individuals, one with that first and the other with that last name.
Code:
  Dim x As Long, sChar As String
  Const Japan = " ??ka?tu?mi?te?ku?lu?ji?ri?ki?zu?me?ta?rinto?mo?no?ke?shiarichido?ru?meina?fu?ra"
  For x = 1 To Len(S)
    sChar = Replace(Mid(LCase(S), x, 1), " ", "`")
    If sChar Like "[`-z]" Then NomeJapa = NomeJapa & Replace(Mid(Japan, 3 * Asc(sChar) - 287, 3), "?", "")
  Next
End Function

Hello Rick

You are missing a number of question marks in the string that you Split ... ;)
 
Upvote 0

Forum statistics

Threads
1,213,531
Messages
6,114,172
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top