Geek asks and answers

Implementing Simple Replacement Encryption Using VBA

I am trying to create a program that changes the letters in a string, and I continue to encounter an obvious problem, if it changes the value, say that it changes A to M, when it gets to M, then it will change that value to M something else , so when I run the code to change it all back, it converts it as if the letter M was originally, not A.

Any ideas how to do this so that the code does not change the letters, has it already changed?

since for the ive code there were just about 40 lines of this (I'm sure this is a cleaner way to do this, but im new for vba, and when I tried to select a case, it would change only one letter and would not go through everything)

Text1.value = Replace(Text1.value, "M", "E")
+3
source share
3

:

Dim strToChange As String
strToChange = "This is my string that will be changed"
Dim arrReplacements As Variant

arrReplacements = Array(Array("a", "m"), _
                        Array("m", "z"), _
                        Array("s", "r"), _
                        Array("r", "q"), _
                        Array("t", "a"))

Dim strOutput As String
strOutput = ""
Dim i As Integer
Dim strCurrentLetter As String

For i = 1 To Len(strToChange)
    strCurrentLetter = Mid(strToChange, i, 1)
    Dim arrReplacement As Variant

    For Each arrReplacement In arrReplacements
        If (strCurrentLetter = arrReplacement(0)) Then
            strCurrentLetter = Replace(strCurrentLetter, arrReplacement(0), arrReplacement(1))
            Exit For
        End If
    Next

    strOutput = strOutput & strCurrentLetter
Next

:

Thir ir zy raqing ahma will be chmnged
+4

, MID. - :

MyVal = text1.value
For X = 1 to Len(MyVal)
  MyVal = Replace(Mid(MyVal, X, 1), "M", "E")
  X = X + 1
Next X

: , . . DLookup , :

MyVal = text1.value
For X = 1 to Len(MyVal)
    NewVal = DLookup("tblConvert", "fldNewVal", "fldOldVal = '" & Mid(MyVal, X, 1) & "")
    MyVal = Replace(Mid(MyVal, X, 1), Mid(MyVal, X, 1), NewVal)
  X = X + 1
Next X
+1

Here's another way that uses fewer loops

Public Function Obfuscate(sInput As String) As String

    Dim vaBefore As Variant
    Dim vaAfter As Variant
    Dim i  As Long
    Dim sReturn As String

    sReturn = sInput
    vaBefore = Split("a,m,s,r,t", ",")
    vaAfter = Split("m,z,r,q,a", ",")

    For i = LBound(vaBefore) To UBound(vaBefore)
        sReturn = Replace$(sReturn, vaBefore(i), "&" & Asc(vaAfter(i)))
    Next i

    For i = LBound(vaAfter) To UBound(vaAfter)
        sReturn = Replace$(sReturn, "&" & Asc(vaAfter(i)), vaAfter(i))
    Next i

    Obfuscate = sReturn

End Function

It turns each letter into an ampersand + replacing ascii letters. Then it replaces each ascii code in the replacement letter.

For nested loops, it took about 5 milliseconds versus 20 milliseconds.

0
source

More articles:


All Articles