逆にするだけのVBA

言葉を逆にするだけです。

A1に入力された文字を逆にするだけです。

Option Explicit

Public Sub 文字列を逆順にする()
    Dim str_入力 As String
    Dim arr_行() As String
    Dim str_行 As String
    Dim str_結果 As String
    Dim lng_i As Long

    ' A1の内容を取得
    str_入力 = Range("A1").Value
    
    ' 改行ごとに分割
    arr_行 = Split(str_入力, vbLf)
    
    ' 各行を逆にして再構成
    For lng_i = LBound(arr_行) To UBound(arr_行)
        arr_行(lng_i) = StrReverse(arr_行(lng_i))
    Next lng_i
    
    ' 改行で再結合（行の順序も逆転）
    For lng_i = UBound(arr_行) To LBound(arr_行) Step -1
        str_結果 = str_結果 & arr_行(lng_i)
        If lng_i > LBound(arr_行) Then str_結果 = str_結果 & vbLf
    Next lng_i
    
    ' 出力をA3セルに書き込む
    Range("A3").Value = str_結果
End Sub

例

造構ーリツのSBW 用運ムラグロプ修研）！るえ使でペピコ（ロクマるす出抽＆換置括一を色のドイラス】ABV tnioPrewoP【

↓

【PowerPoint VBA】スライドの色を一括置換＆抽出するマクロ（コピペで使える！）研修プログラム運用 WBSのツリー構造

おまけ

Option Explicit



Sub Encrypt_Execute()
    Dim inputString As String
    Dim linesArray As Variant
    Dim encryptedResult As String
    Dim singleLine As String
    Dim i As Long

    inputString = ActiveSheet.Range("A1").Value
    encryptedResult = ""

    If inputString = "" Then
        MsgBox "No text found in cell A1.", vbExclamation
        Exit Sub
    End If

    linesArray = Split(Replace(inputString, vbCrLf, vbLf), vbLf)

    For i = 0 To UBound(linesArray)
        singleLine = linesArray(i)

        If i > 0 Then
            encryptedResult = encryptedResult & vbCrLf & Encrypt_StringProcess(singleLine)
        Else
            encryptedResult = Encrypt_StringProcess(singleLine)
        End If
    Next i

    ActiveSheet.Range("B1").Value = encryptedResult
    MsgBox "Encryption complete. Please check cell B1.", vbInformation
End Sub

Private Function Encrypt_StringProcess(ByVal p_targetString As String) As String
    Dim swappedString As String
    Dim finalResult As String
    Dim i As Long
    Dim stringLength As Long

    swappedString = ""
    stringLength = Len(p_targetString)

    For i = 1 To stringLength Step 2
        If i + 1 <= stringLength Then
            swappedString = swappedString & Mid(p_targetString, i + 1, 1) & Mid(p_targetString, i, 1)
        Else
            swappedString = swappedString & Mid(p_targetString, i, 1)
        End If
    Next i

    finalResult = StrReverse(swappedString)
    Encrypt_StringProcess = finalResult
End Function

Sub Decrypt_Execute()
    Dim inputString As String
    Dim linesArray As Variant
    Dim decryptedResult As String
    Dim singleLine As String
    Dim i As Long

    inputString = ActiveSheet.Range("B1").Value
    decryptedResult = ""

    If inputString = "" Then
        MsgBox "No text found in cell B1.", vbExclamation
        Exit Sub
    End If

    linesArray = Split(Replace(inputString, vbCrLf, vbLf), vbLf)

    For i = 0 To UBound(linesArray)
        singleLine = linesArray(i)

        If i > 0 Then
            decryptedResult = decryptedResult & vbCrLf & Decrypt_StringProcess(singleLine)
        Else
            decryptedResult = Decrypt_StringProcess(singleLine)
        End If
    Next i

    ActiveSheet.Range("C1").Value = decryptedResult
    MsgBox "Decryption complete. Please check cell C1.", vbInformation
End Sub

Private Function Decrypt_StringProcess(ByVal p_targetString As String) As String
    Dim reversedString As String
    Dim finalResult As String
    Dim i As Long
    Dim stringLength As Long

    finalResult = ""

    reversedString = StrReverse(p_targetString)
    stringLength = Len(reversedString)

    For i = 1 To stringLength Step 2
        If i + 1 <= stringLength Then
            finalResult = finalResult & Mid(reversedString, i + 1, 1) & Mid(reversedString, i, 1)
        Else
            finalResult = finalResult & Mid(reversedString, i, 1)
        End If
    Next i

    Decrypt_StringProcess = finalResult
End Function