CODEWITHSUNDEEP
vbaexcel
Oday Salim
Oday Salim

Reputation: 1147

Perform character substitution using Excel VBA

Say you would like to set up a very simple Caesar Cipher, where A --> 1, B --> 2 ... etc.

Say you have a word "Hello" in a cell that you would like to encrypt. You can set up a very simple For Loop to loop through each word:

For i = 1 To Len("Hello")
    'perform encryption here
Next i

Is there a quick an easy way to map values from a pre-defined range? I.e. we know that A = 1, or 1 + 26, or 1 + 2*(26) .. etc...

Rather than writing IF statement to check for all letters, I wonder if there is an elegant way of doing this to get: "8 5 12 12 15"

Upvotes: 1

Views: 1358

Answers (4)

JNevill
JNevill

Reputation: 50019

Using the Dictionary route, you can build a dictionary which is a list of key, value pairs to hold your cypher. In your case the key of a would have the value 1 and the key of b would have the value 2, and so on. Then you can just bump your word, letter by letter, against the dictionary to build your cipher:

Function caesarCipher(word As String) As String

    'create an array of letters in their position for the cipher (a is 1st, b is 2nd)
    Dim arrCipher As Variant
    arrCipher = Split("a b c d e f g h i j k l m n o p q r s t u v x y z", " ")

    'Create a dictionary from the array with the key being the letter and the item being index + 1
    Dim dictCipher As Scripting.Dictionary
    Set dictCipher = New Dictionary
    For i = 0 To UBound(arrCipher)
        dictCipher.Add arrCipher(i), i + 1
    Next

    'Now loop through the word letter by letter
    For i = 1 To Len(word)
        'and build the cipher output
        caesarCipher = caesarCipher & IIf(Len(caesarCipher) = 0, "", " ") & dictCipher(LCase(Mid(word, i, 1)))
    Next

End Function

This is a nice way of doing it because you can change your cipher to be whatever you want and you only need monkey with your dictionary. Here I just build a dictionary from an array and use the array's index for the cipher output.

Upvotes: 2

Ibo
Ibo

Reputation: 4309

All of the answers are good, but this is how you use a dictionary which is simpler and more straight-forward. I defined the dictionary implicitly to make it easier to start, but it is better to define it explicitly by adding runtime scripting from the tools>references in VBE.

Sub Main()
    Dim i As Integer
    Dim ciphered As String, str As String
    Dim dict As Object

    Set dict = CreateObject("scripting.Dictionary")
    str = "Hello"

    For i = 65 To 122
        dict.Add Chr(i), i - 64
    Next i

    For i = 1 To Len(str)
        ciphered = ciphered & "-" & dict(Mid(UCase(str), i, 1))
    Next i
    ciphered = Right(ciphered, Len(ciphered) - 1)

    Debug.Print ciphered
End Sub

if you remove ucase when getting the code from the dictionary it will count for the case meaning that uppercase or lowercase will have different codes. You can change this to a function easily, don't forget to remove str = "Hello". Right now it returns:

Output

8-5-12-12-15

Upvotes: 1

John Coleman
John Coleman

Reputation: 51998

This might get you started:

Function StringToNums(s As String) As Variant
    'assumes that s is in the alphabet A, B, ..., Z
    Dim nums As Variant
    Dim i As Long, n As Long
    n = Len(s)
    ReDim nums(1 To n)
    For i = 1 To n
        nums(i) = Asc(Mid(s, i, 1)) - Asc("A") + 1
    Next i
    StringToNums = nums
End Function

Sub test()
    Debug.Print Join(StringToNums("HELLO"), "-") 'prints 8-5-12-12-15
End Sub

Upvotes: 1

Cyril
Cyril

Reputation: 6829

Get the cell's output as a string with Byte array:

Dim brr() As Byte, i As Long, k As String
brr() = StrConv(Cells(1, 3), vbFromUnicode)

Then assess each letter in the new array against a larger array:

dim arr as variant
arr = array("a", "b")
For i = 0 To UBound(brr) 'need to start at 0, lbound applies for std array, not byte
    'match brr value to arr value, output arr location
    'k will store the final string
    k = k + 'didn't look up the output for application.match(arr())
Next i

Edit1: Thanks to JohnColeman, i can add Asc() to the above and it shouldn't need the additional array for A, B, C, etc.

Dim brr() As Byte, i As Long, k As String
brr() = StrConv(Cells(1, 3), vbFromUnicode)
for i = 0 To UBound(brr) 
    k = k & " " & Asc(brr(i)) 'something like that
next i

Upvotes: 3

Related Questions