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
 

Some videos you may like

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!

wigi

Well-known Member
Joined
Jul 10, 2006
Messages
7,958
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
  3. Web
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
 

Leandroarb

Board Regular
Joined
Oct 7, 2014
Messages
157
Wigi!! Great show, I did not know this function, I still have much to learn, thanks.
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,718
Office Version
  1. 2010
Platform
  1. Windows
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
 

Leandroarb

Board Regular
Joined
Oct 7, 2014
Messages
157

ADVERTISEMENT

Arigato Mr. Shikimime Shimochiriarichikukito! :cool:
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,718
Office Version
  1. 2010
Platform
  1. Windows
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
 

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,782
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

Maybe they'll do one of these for VBA, Rick. You'd be a shoo-in!
 
Last edited by a moderator:

Leandroarb

Board Regular
Joined
Oct 7, 2014
Messages
157
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
 

wigi

Well-known Member
Joined
Jul 10, 2006
Messages
7,958
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
  3. Web
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 ... ;)
 

Watch MrExcel Video

Forum statistics

Threads
1,123,385
Messages
5,601,331
Members
414,446
Latest member
CRAVIN

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
Top