回文判定マクロ

回文とは、
前から読んでも後ろから読んでも同じ文のことです。

Wikipediaによると日本語の回文では
濁音、半濁音、促音、拗音は
清音と同一として考えることが多いようですが
まずはこれらを別物とした回文判定をしてみます。

回文を判定する文はひらがなで入力します。
これを逆に並べた文字列を作成します。
これを元の文と比較して
同じなら回文と判定します。

コードはこちら

Sub Palindrome(Str As String)
'完全回文判定マクロ

    Dim i As Integer
    Dim Str2 As String
   
    '反対から並べ替える
    For i = Len(Str) To 1 Step -1
        Str2 = Str2 + Mid(Str, i, 1)
    Next i
   
    '回文かどうかの判定
    If Str = Str2 Then
        MsgBox "「" & Str & "」は回文です。"
    Else
        MsgBox "「" & Str & "」回文ではありません。" & Chr(10) & _
            "逆は「" & Str2 & "」"
    End If
   
End Sub

Sub macro110319a()
'Palindrome使用例

    Call Palindrome("madamimadam")
   
End Sub

次は
濁音、半濁音、促音、拗音は
清音と同一として考える回文判定をします。

今回もまず最初に逆に並べた文字列を作成します。

回文の判定をする部分ですが
一文字づつ比較していきます。

ひらがなを
濁音、半濁音、促音、拗音のそれぞれの有無で
グループ分けします。

グループ分けは以下のとおり

清音のみのグループ：
あ、な行、ま行、ら行、ゐゑをん
清音と小さい字のみのグループ：
いうえお、やゆよ、わ
清音と濁音のグループ：
か行、さ行、たちてと
清音、濁音、半濁音のグループ：
は行
清音、濁音、小さい字のグループ：
つ

次のコードで
ひらがなと文字コードを
書き出してみるとわかりやすいです。

Sub macro110319b()
'ひらがなと文字コードを出力する

    Dim i As Long
    Sheets.Add
    For i = -32096 To -32015
        Cells(i + 32097, 1) = i
        Cells(i + 32097, 2) = Chr(i)
    Next i
   
End Sub

それぞれの文字の判定はASC関数を使って
文字コードでします。

Selectステートメントで
それぞれのグループ別に分岐して
それぞれ清音、濁音、半濁音、促音、拗音を同一として
もとの文の文字と比較して同一かどうかの
判定をします。

一個でも同一でないと判定されると
変数flagが0より大きい整数になります。
コードはこちら

Sub Palindrome2(Str As String)
'回文判定マクロ

    Dim i As Integer
    Dim Str2 As String
   
    '反対から並べ替える
    For i = Len(Str) To 1 Step -1
        Str2 = Str2 + Mid(Str, i, 1)
    Next i
   
    Dim flag As Integer
    flag = 0
    '回文かどうかの判定
    For i = Len(Str) To 1 Step -1
        Select Case Asc(Mid(Str, i, 1))
            Case -32056 To -32052, -32036 To -32032, -32025 To -32021, -32018 To -32015
            '濁音などなし
                If Mid(Str, i, 1) <> Mid(Str2, i, 1) Then
                    flag = flag + 1
                End If
            Case -32087 To -32064
            '濁音あり(か～ち)
            '偶数が濁音
                If Asc(Mid(Str, i, 1)) Mod 2 = 0 Then
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) - 1) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                Else
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) + 1) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                End If
            Case -32060 To -32057
            '濁音あり(て～と)
            '奇数が濁音
                If Asc(Mid(Str, i, 1)) Mod 2 = 0 Then
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) + 1) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                Else
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) - 1) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                End If
            
            Case -32051 To -32037
            'はばぱ行
                If ((Asc(Mid(Str, i, 1)) + 32051) Mod 3) = 0 Then
                    'は行
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) + 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) + 2) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                ElseIf ((Asc(Mid(Str, i, 1)) + 32051) Mod 3) = 1 Then
                    'ば行
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) - 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) + 1) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                ElseIf ((Asc(Mid(Str, i, 1)) + 32051) Mod 3) = 2 Then
                    'ぱ行
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) - 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) - 2) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                End If
               
            Case -32063 To -32061
            'つづっ
                If Mid(Str, i, 1) = "つ" Then
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) - 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) + 1) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                ElseIf Mid(Str, i, 1) = "づ" Then
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) - 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) - 2) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                ElseIf Mid(Str, i, 1) = "っ" Then
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) + 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) + 2) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                End If
            Case -32097 To -32088, -32031 To -32026
            'あいうえお、やゆよ（小さい音あり）
                If (Asc(Mid(Str, i, 1)) Mod 2) = 0 Then
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) - 1) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                Else
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) + 1) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                End If
            Case -32020 To -32019
            'ゎわ
                If Mid(Str, i, 1) = "ゎ" Then
                '小さい音
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) - 1) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                ElseIf Mid(Str, i, 1) = "わ" Then
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) + 1) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                End If
            Case Else
            'その他
                If Mid(Str, i, 1) <> Mid(Str2, i, 1) Then
                    flag = flag + 1
                End If
        End Select
    Next i
   
    If flag = 0 Then
        MsgBox "「" & Str & "」は回文です。"
    Else
        MsgBox "「" & Str & "」回文ではありません。" & Chr(10) & _
            "逆は「" & Str2 & "」" & Chr(10) & _
            "flag = " & flag
    End If
   
End Sub

Sub macro110319c()
'Palindrome2使用例

    Call Palindrome2("つつみがみっつ")
   
End Sub

とりわけ回文を考えることはないけれど、
なんとなく作ってみました。