Criptografía (CCLVIII): Cifrado Atbash en Excel

Ya puse una entrada con un script en python para cifrar y descifrar utilizando el cifrado Atbash, y en ésta pongo el código Visual Basic para aplicaciones (VBA) para automatizar en Excel esa misma tarea.

El cifrado Atbash es un criptosistema de sustitución simple monoalfabética de alfabeto invertido, es decir, cada carácter del texto en claro se sustituye siempre por el mismo carácter en el texto cifrado, el situado en la misma posición que el carácter del texto en claro en el alfabeto con el orden de los caracteres invertido.

El código es el siguiente:

' CIFRADO ATBASH:
'
' Cifra y descifra textos en claro y criptogramas, respectivamente,
' utilizando el cifrado Atbash.
'
' http://mikelgarcialarragan.blogspot.com/

Option Explicit
Public TEXTO_CLARO As Range
Public CRIPTOGRAMA As Range
Public Sub Cifrar()
    Dim Caracter As Integer

    Range("TEXTO_CLARO").Value = A_Z(UCase(Replace(Range("TEXTO_CLARO").Value, " ", "")))
    
    If Len(Range("TEXTO_CLARO").Value) = 0 Then
        MsgBox "Introduzca el texto en claro a cifrar. Sólo caracteres alfabéticos [A-Z], 'Ñ' excluida.", vbOKOnly + vbCritical, "¡Error!"
    Else
        Range("CRIPTOGRAMA").Value = ""
        For Caracter = 1 To Len(Range("TEXTO_CLARO").Value)
            Range("CRIPTOGRAMA").Value = Range("CRIPTOGRAMA").Value & Chr(25 - (Asc(Mid(Range("TEXTO_CLARO").Value, Caracter, 1)) - 65) + 65)
        Next
    End If

End Sub
Public Sub Descifrar()
    Dim Caracter As Integer

    Range("CRIPTOGRAMA").Value = A_Z(UCase(Replace(Range("CRIPTOGRAMA").Value, " ", "")))
    
    If Len(Range("CRIPTOGRAMA").Value) = 0 Then
        MsgBox "Introduzca el criptograma a descifrar. Sólo caracteres alfabéticos [A-Z], 'Ñ' excluida.", vbOKOnly + vbCritical, "¡Error!"
    Else
        Range("TEXTO_CLARO").Value = ""
        For Caracter = 1 To Len(Range("CRIPTOGRAMA").Value)
            Range("TEXTO_CLARO").Value = Range("TEXTO_CLARO").Value & Chr(25 - (Asc(Mid(Range("CRIPTOGRAMA").Value, Caracter, 1)) - 65) + 65)
        Next
    End If

End Sub
Function A_Z(Cadena As String) As String
    Dim Caracter As Integer

    For Caracter = 1 To Len(Cadena)
        Select Case Asc(Mid(Cadena, Caracter, 1))
            Case 65 To 90:
                A_Z = A_Z & Mid(Cadena, Caracter, 1)
        End Select
    Next

End Function

Ejemplo de funcionamiento:

- Cifrar:

- Descifrar:

Quizás también te interese: