Option Explicit

Sub Uranai()

    ' 相性を占いたい男女の名前をそれぞれ半角カタカナで設定してください。
    Dim S_Name      As String, S_Int       As String, S_Wk       As String
    Dim i           As Long
    Dim Man         As String: Man = "ﾆｼｼﾞﾏﾋﾃﾞﾄｼ"
    Dim Woman       As String: Woman = "ｱﾗｶﾞｷﾕｲ"
    
    ' 名前に濁音、ぱく音があれば消去し、並べて表示
    S_Name = Replace(Replace(Man & Woman, "ﾞ", ""), "ﾟ", ""): Debug.Print S_Name ' 名前を並べて表示
    
    ' 名前の数値化
    For i = 1 To Len(S_Name)
        If InStr("ｱｶｻﾀﾅﾊﾏﾔﾗﾜｧｬ", Mid(S_Name, i, 1)) > 0 Then S_Int = S_Int & "1"    ' 母音アは 1
        If InStr("ｲｷｼﾁﾆﾋﾐﾘｨ", Mid(S_Name, i, 1)) > 0 Then S_Int = S_Int & "2"       '     イは 2
        If InStr("ｳｸｽﾂﾇﾌﾑﾕﾙｩｭｯ", Mid(S_Name, i, 1)) > 0 Then S_Int = S_Int & "3"    '     ウは 3
        If InStr("ｴｹｾﾃﾈﾍﾒﾚｪ", Mid(S_Name, i, 1)) > 0 Then S_Int = S_Int & "4"       '     エは 4
        If InStr("ｵｺｿﾄﾉﾎﾓﾖﾛｦｫｮ", Mid(S_Name, i, 1)) > 0 Then S_Int = S_Int & "5"    '     オは 5
        If InStr("ﾝ", Mid(S_Name, i, 1)) > 0 Then S_Int = S_Int & "0"               '     ンは 0
    Next
    
    ' 100％以下になるまで計算を繰り返す
    Do
        Debug.Print S_Int   ' 数値の表示
        If S_Int = "100" Or Len(S_Int) < 3 Then Exit Do
        
        ' 隣り合う数値を足し、1桁目だけを再度並べていく
        S_Wk = ""
        For i = 1 To Len(S_Int) - 1
            S_Wk = S_Wk & Right(CStr(Val(Mid(S_Int, i, 1)) + Val(Mid(S_Int, i + 1, 1))), 1)
        Next
        S_Int = S_Wk
    Loop
    
    Debug.Print "二人の相性は " & S_Int; " ％です"

End Sub

• Like
• LINE
• Tweet
• Copy URL