This page contains four examples of how to use rather simple techniques to encode data. Each of the techniques relies on a character-by-character encoding. Consequently, none of them are useful for anything but trivial use. In addition, two (#2 and #3) rely on Excel specific capability.
Common SetupFor all but the first example, the data are assumed to be organized as follows. Column A of the active worksheet lists the character to be encoded. Column C lists the corresponding code to use as a 2 character hex code. The string being encoded is in E1. The first three functions are used in an Excel worksheet as shown in Figure 2.
The last function is demonstrated in Figure 3. |
|
Hex codesThe function KeyToHex simply converts the string in E1 into its hex equivalent. Public Function KeyToHex(ByVal sKey As String) As String Dim i As Long, CodedKey As String CodedKey = "" For i = 1 To Len(sKey) CodedKey = CodedKey & Right("0" & Hex(Asc(Mid(sKey, i, 1))), 2) Next i KeyToHex = CodedKey End Function
|
Case Insensitive EncodingThis technique leverages the fact that Excel VBA can use certain Excel functions. Since the mapping information is in two ranges, the code uses the INDEX and MATCH functions to lookup the the code values corresponding to each character. Function SecretCodeCI(x As String, LookupVals, MatchingCodes) As String 'LookupVals is a Mx1 range, with each cell containing a single character _ MatchingCodes is a Mx1 range. Dim i As Integer, Rslt As String On Error GoTo ErrXIT For i = 1 To Len(x) Rslt = Rslt _ & MatchingCodes(Application.WorksheetFunction.Match(Mid(x, i, 1), LookupVals, 0)) Next i SecretCodeCI = Rslt Exit Function ErrXIT: SecretCodeCI = "Error: " & Err.Description & " (" & Err.Number & ")" End Function Sub testItCI() Dim x, y With ActiveSheet Set x = .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown)) Set y = x.Offset(, 2) End With MsgBox SecretCodeCI("nickelson", x, y) End Sub
|
Case Sensitive EncodingSince the lookup functions in Excel (MATCH, VLOOKUP, etc.) are case insensitive, the code below uses the one Excel function that is case sensitive -- FIND -- to search a string. Obviously, that requires that the mapping information be converted to a string. The code uses the Excel TRANSPOSE and the VBA 6 Join functions to accomplish that. Note that a variant that combines a component of the previous technique would be for the code to use the result of the FIND to index into the MatchingCodes range as above. That would lift the restriction that each cell in MatchingCodes strictly contain a two character hex code. Function SecretCode(x As String, LookupVals, MatchingCodes) As String 'LookupVals is a Mx1 range, with each cell containing a single character _ MatchingCodes is a Mx1 range, with each cell containing a 2 character _ hex code. Dim i As Integer, Rslt As String, sLookup, sMatches 'On Error GoTo ErrXIT With Application.WorksheetFunction sLookup = Join(.Transpose(LookupVals.Value), "") sMatches = Join(.Transpose(MatchingCodes.Value), "") End With For i = 1 To Len(x) Rslt = Rslt _ & Mid(sMatches, _ (Application.WorksheetFunction.Find(Mid(x, i, 1), sLookup) - 1) * 2 + 1, 2) Next i SecretCode = Rslt Exit Function ErrXIT: SecretCode = "Error: " & Err.Description & " (" & Err.Number & ")" End Function Sub testIt() Dim x, y With ActiveSheet Set x = .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown)) Set y = x.Offset(, 2) End With MsgBox SecretCode("nickelson", x, y) End Sub
|
Fast EncodingThis technique initializes a data structure to facilitate a direct lookup of the the character being encoded. It does this by putting the code corresponding to a particular character into an array location given by the ASCII code of the character. For example, consider the character A. Its ASCII code is 41. Hence the array element 41 contains the code corresponding to the letter A. Consequently, to find the code corresponding to A, all one needs to do is array(ASC("A")) This technique bends Excel's rules of how a function is supposed to work. The SetupLookupMap function actually initializes a global table that is used by the FastLookup function for the actual lookup. To ensure that Excel calls the LookupMap function both when the string to be encoded changes and when the encoding map changes, the encoding map is passed to the function in the 2nd and 3rd arguments; however, the LookupVals function really uses only first argument. This set of functions is used as shown below.
Option Explicit Dim LookUpMap(0 To 255) Function SetupLookUpMap(LookupVals, MatchingCodes) 'LookupVals and MatchingCodes must contain just one area _ The code currently doesn't cater to anything but a range Dim i As Integer For i = 1 To LookupVals.Cells.Count LookUpMap(Asc(LookupVals.Cells(i).Value)) = MatchingCodes.Cells(i).Value Next i SetupLookUpMap = 0 End Function Function FastLookup(x As String, LookupVals, MatchingCodes) Dim i As Integer, Rslt As String For i = 1 To Len(x) Rslt = Rslt & LookUpMap(Asc(Mid(x, i, 1))) Next i FastLookup = Rslt End Function
|