so I am making a decryption software that allows the user to input some text and then they can swap out letters in the program. For example, there is a drop down box that allows you to swap all the "O"'s in a user input to "W". So in the input "Stack overflow" the output would be "Stack wverflww".
However, my problem is is that when the user chooses a second letter to change, that has already been swapped, it causes a problem. For example, after the first above example has occurred, if the user then wanted to then change all the "W"'s in their input to "A"'s the output would be "stack averflaa". However, what I'm looking for the code to do is give an output of "Stack wverflwa". So only the original "W"'s of the user input are changed to the letter "A".
I hope the above makes sense.
Someone suggested using a two dimensional array to reassign the letters new letters and I am able to do this, but I have no idea how to then put this into my code and get it working. Below is my code and thank you to anyone who can help me.
Dim chooseLetter, replaceLetter, words2
chooseLetter = selectLetterCombo.Text
replaceLetter = replaceLetterCombo.Text
words2 = UCase(textInputBox.Text)
Dim replaceList As New List(Of String)
For Each z In words2
If z = chooseLetter Then
replaceList.Add(replaceLetter)
Else
replaceList.Add(z)
End If
Next
letterReplaceBox.Text = ""
For Each f In replaceList
letterReplaceBox.Text = letterReplaceBox.Text & f
Next
note: selectLetterCombo.Text is the letter chosen by the user that they want to replace and replaceLetterCombo.Text is the letter chosen by the user that they want to swap the first chosen letter with. Also, textInputBox.text is the text the user has inputted.
Thank you!
You should be able to keep a list of the index of the character that changed and check that before making another change.
'List to keep track of changed character index
Dim replacedCharsList As New List(Of Integer)'member variable
Dim chooseLetter, replaceLetter, words2
chooseLetter = selectLetterCombo.Text
replaceLetter = replaceLetterCombo.Text
words2 = UCase(textInputBox.Text)
Dim replaceList As New List(Of String)
Dim i As Integer
For i = 1 To Len(words2)
'remove the for each and go with a straight for loop to keep track if the index
If Mid(words2, i, 1) = chooseLetter Then
'check to see if we have already replaced this character via the index position
If replacedCharsList.Contains(i) = False Then
'we have not changed this so add the replacement letter and update our index list
replaceList.Add(replaceLetter)
replacedCharsList.Add(i)
Else
'we have already changed this character so just add it as is
replaceList.Add(Mid(words2, i, 1))
End If
Else
replaceList.Add(Mid(words2, i, 1))
End If
Next
letterReplaceBox.Text = ""
For Each f In replaceList
letterReplaceBox.Text = letterReplaceBox.Text & f
Next
I have an answer, but you're really not going to like it:
Option Infer On
Option Strict On
Imports System.Text.RegularExpressions
Module Module1
Dim swaps As New Dictionary(Of Char, Char)
Function DoSwaps(originalText As String, swapLetters As Dictionary(Of Char, Char)) As String
Dim newText As String = ""
For Each c In originalText
If swapLetters.ContainsKey(c) Then
newText &= swapLetters(c)
Else
newText &= c
End If
Next
Return newText
End Function
Sub Main()
Console.Write("Enter the text to be altered: ")
Dim t = Console.ReadLine()
Dim exitNow = False
Do
Console.Write("Enter the letter to swap from and the letter to swap to, or a blank line to quit: ")
Dim s = Console.ReadLine()
If s.Trim().Length = 0 Then
exitNow = True
Else
Dim parts = Regex.Matches(s, "([A-Za-z])")
If parts.Count >= 2 Then
Dim letter1 = CChar(parts.Item(0).Value)
Dim letter2 = CChar(parts.Item(1).Value)
If swaps.ContainsKey(letter1) Then
swaps.Item(letter1) = letter2
Else
swaps.Add(letter1, letter2)
End If
Console.WriteLine(DoSwaps(t, swaps))
End If
End If
Loop Until exitNow
End Sub
End Module
... unless you'd like to learn about the Dictionary class to understand how it works. I used a simple regular expression to parse the user input, but if you're using dropdowns to select the letters then that would just be bonus learning if you explore it.
The essential feature is that you keep the original string (t in the above code) and apply the transformation (I named it DoSwaps) to that each time, not to the previously transformed string.
These two functions will do the job, although there is no allowance for punctuation, just spaces.
Private Function EncryptText(str As String) As String
Dim swapletters() As String = {"l", "s", "d", "f", "g", "h", "j", "k", "a", "q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "z", "x", "c", "v", "b", "n", "m"}
Dim encryptedText As String = ""
For Each letter As Char In str
If letter = " "c Then
encryptedText = encryptedText & " "
Else
Dim charactercode As Integer = Asc(letter) - 97
encryptedText = encryptedText & swapletters(charactercode)
End If
Next
Return encryptedText
End Function
Private Function DecryptText(str As String) As String
Dim swapletters As New List(Of String) From {"l", "s", "d", "f", "g", "h", "j", "k", "a", "q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "z", "x", "c", "v", "b", "n", "m"}
Dim decryptedText As String = ""
For Each letter As Char In str
If letter = " "c Then
decryptedText = decryptedText & " "
Else
Dim character As String = Chr(swapletters.IndexOf(letter) + 97)
decryptedText = decryptedText & character
End If
Next
Return decryptedText
End Function
To use them, declare a string to hold the return value of each function
Dim etext As String
etext = EncryptText("disambiguation is the root of all evil")
results in etext being "faplrsajxlzayt ap zkg oyyz yh lee gcae"
and
Dim dtext As String
dtext = DecryptText("faplrsajxlzayt ap zkg oyyz yh lee gcae")
results in "disambiguation is the root of all evil"
Related
What is shortcut of checking string value like this.
If midtxt = "a" Then
midtxt = "apple"
ElseIf midtxt = "b" Then
midtxt = "ball"
ElseIf midtxt = "c" Then
midtxt = "cat"
.....
ElseIf midtxt = "z" Then
midtxt = "zebra"
End If
MsgBox midtxt
Is there any way I can do this using two arrays.
[a, b, c....z] and [apple, ball, cat.....zebra]
Edit
I need reproducible function for my task.
I think a for apple is not right example for me.
This is updated array for me.
[ap, bl, ca,... zr] [apple, ball, cat... zebra]
means the two letter code is derived from the corresponding string but it is not uniformly derived.
A dictionary may be worthwhile here, as long as the [a, b, ...z] set is unique.
In the VBA IDE, go to Tools, References, and select Windows Scripting Runtime.
Public gdctAnimals As Dictionary
Public Sub SetUpAnimalDictionary()
Set gdctAnimals = new Scripting.Dictionary
gdctAnimals.Add "a", "apple"
gdctAnimals.Add "b", "ball"
gdctAnimals.Add "c", "cat"
gdctAnimals.Add "z", "zebra"
End Sub
Public Sub YourProc(midtxt As String)
If gdctAnimals Is Nothing Then
SetUpAnimalDictionary
End If
If gdctAnimals.Exists(midtxt) Then
MsgBox gdctAnimals(midtxt)
Else
MsgBox "Item not found in dictionary", vbExclamation
End if
End Sub
Use the Select Case or Switch function
Function SwapString(strInput As String)
SwapString= Switch(strInput = "a", "Apple", strInput = "b", "Banana", strInput = "c", "Cherry")
End Function
In your case, if you can only have 26 combinations (a-z) the easiest way is to do this:
Public Function ReturnString(strIn As String) As String
Select Case strIn
Case "a"
ReturnString = "apple"
Case "b"
ReturnString = "ball"
Case "c"
ReturnString = "cat"
' .............
Case Else
ReturnString = "UNKNOWN"
End Select
End Function
and you call your fonction like this
MyLongString = ReturnString "a"
But there are many more possibililities that I won't detail because you have not detailed enough your question:
You can use 2 arrays or a 2D array
you can use an array of private types
you can use a dictionary as specified in another answer
No need for an external component or tedious population, you are looking for something based on an ordinal value; a=>z is the character code range 97=>122 so you can use a simple efficient array lookup by converting the character code to a value within the bounds of the array:
'//populate (once)
Dim map() As String: map = Split("apple,ball,cat,...,zebra", ",")
'//lookup
midtxt = "a"
midtxt = map(Asc(Left$(midtxt, 1)) - 97)
'=>apple
midtxt = "c"
midtxt = map(Asc(Left$(midtxt, 1)) - 97)
'=>cat
If needed check the value starts with a character first with if midtxt like "[a-z]*" then ...
When I do the following....
Dim s As String = ""
Dim sLines() As String = s.Split("|", StringSplitOptions.None)
...
sLines.Count is 1.
Why?
There is nothing to split, and the string to be split is empty, so I would expect sLines.Count to be 0.
Thank you.
A sort of consistency: if "a|b" split on | is ["a", "b"] and "a" split on | is ["a"], it makes some sense for "|b" split on | to be ["", "b"] and "" split on | to be [""].
You can remove all empty entries by passing StringSplitOptions.RemoveEmptyEntries instead of None, or just check for s = String.Empty manually otherwise.
Check the documentation of Split:
If this instance does not contain any of the strings in separator, the returned array consists of a single element that contains this instance.
This is your case. "" doesn't contain "|", so a single element "" is returned.
You can use IIf() function to handle empty string
Dim s As String = ""
Dim sLines() As String = IIf(s = String.Empty, Nothing, s.Split("|"))
Dim cnt As Integer
If sLines IsNot Nothing Then
'your code
cnt = sLines.Count
Else
'your code
cnt = 0
End If
Note: In case if you want to handle white spaces(Dim s As String = " ") just use trim() like this
IIf(Trim(s) = String.Empty, Nothing, s.Split("|"))
Within the worksheet that the macro is defined in, id like to iterate through all the columns and save the ones that are filled in an array.
x = IIf(WorksheetFunction.CountA(Columns("C")) > 0, 1, 0)
This is an example of how I'd check if the column is empty. It returns 1 if the column is filled and 0 if it is empty.
Another thing that I'd like to know is how I could give and get the column name as a variable rather than hardcoded string ("C" as you see above).
Id like the array to look like:
("A", "B", "C", "E", "G", "H", "I")
This code should do the trick:
Dim DataCols() As String
Dim strTemp As String
Dim strCol As String
Dim i As Long
For i = 1 To ActiveSheet.UsedRange.Columns.Count
If WorksheetFunction.CountA(Columns(i)) > 0 Then
strCol = Columns(i).Address
strTemp = strTemp & Mid(strCol, 2, InStr(strCol, ":") - 2) & "|"
End If
Next i
strTemp = Left(strTemp, Len(strTemp) - 1) 'Trim trailing |
DataCols = Split(strTemp, "|")
The For..Next loop iterates through all columns in the active worksheet.
Using WorksheetFunction.CountA as you also used in your example it is then determined whether the current column has any data in it.
If the column contains data we get its address (Which will be a string in the format $A:$A) and use Mid(..) to get the letters between the $ character and the : character.
Append that column letter to strTemp, followed by a Pipe | which we will later use as a delimiter.
The Dynamic Array DataCols is then populated by using the Split function on strTemp to return a string array (delimited by the |s we included).
Hope this helps!
I am trying to make a program that changes letters in a string and i keep running into the obvious issue of if it changes a value, say it changes A to M, when it gets to M it will then change that M to something else, so when i run the code to change it all back it converts it as if the letter was originally an M not an A.
Any ideas how to make it so the code doesnt change letters its already changed?
as for code ive just got about 40 lines of this (im sure theres a cleaner way to do it but im new to vba and when i tried select case it would only change one letter and not go through all of them)
Text1.value = Replace(Text1.value, "M", "E")
Try this:
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
Here is the output:
Thir ir zy raqing ahma will be chmnged
Loop through it using the MID function. Something like:
MyVal = text1.value
For X = 1 to Len(MyVal)
MyVal = Replace(Mid(MyVal, X, 1), "M", "E")
X = X + 1
Next X
EDIT: OK upon further light, I'm gonna make one change. Store the pairs in a table. Then you can use DLookup to do the translation, using the same concept:
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
Here's another way that uses less 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 every letter into an ampersand + the replacement letters ascii code. Then it turns every ascii code in the replacement letter.
It took about 5 milliseconds vs 20 milliseconds for the nested loops.
hello
Im using VB 2008
is it possible to set array items with one line code?
for example, can i do something like:
Dim array = Array("a", "b", "c", "d")
instead of:
Dim array()
array(0) = "a"
array(1) = "b"
array(2) = "c"
array(3) = "d"
thanks
You can use the following to initialize an array with explicit members.
Dim array As String() = New String(){"a", "b", "c", "d"}
This can be done with any type.
Yes using the below format:
Dim boolArr As Boolean() = New Boolean() {True, True, False, True}