Deze veelzijdige en nuttige functie vond ik in een boek genaamd: VBA Developer’s Handbook, 2nd Edition
Dus alle credits gaan naar de schrijvers Ken Getz en Mike Gilbert.

Essentiële functie wanneer je met veel tekenreeksen moet werken bijvoorbeeld postcodes of als je vaak karakters (tekens) moet vervangen binnen een tekenreeks. Ik beveel het boek aan als je zogenaamde bullet-proof vba-code moet schrijven.

Public Function dhTranslate(ByVal strIn As String, _
ByVal strMapIn As String, _
ByVal strMapOut As String, _
Optional lngCompare As VbCompareMethod = vbBinaryCompare) As String
‘ In:
‘ strIn:
‘ String in which to perform replacements
‘ strMapIn:
‘ Map of characters to find
‘ strMapOut:
‘ Map of characters to replace. If the length
‘ of this string is shorter than that of strMapIn,
‘ use the final character in the string for all
‘ subsequent matches.
‘ Example:
‘ dhTranslate(“This is a test”, “aeiou”, “AEIOU”) returns
‘ “ThIs Is A tEst”
‘ Used by:
‘ dhExtractString
‘ dhExtractCollection
‘ dhTrimAll
‘ dhCountWords
‘ dhCountTokens

Dim lngI As Long
Dim lngPos As Long
Dim strChar As String * 1
Dim strOut As String

' If there's no list of characters
' to replace, there's no point going on
' with the work in this function.
If Len(strMapIn) > 0 Then
    ' Right-fill the strMapOut set.
    If Len(strMapOut) > 0 Then
        strMapOut = Left$(strMapOut & String(Len(strMapIn), _
        Right$(strMapOut, 1)), Len(strMapIn))
    End If

    For lngI = 1 To Len(strIn)
        strChar = Mid$(strIn, lngI, 1)
        lngPos = InStr(1, strMapIn, strChar, lngCompare)
        If lngPos > 0 Then
            ' If strMapOut is empty, this doesn't fail,
            ' because Mid handles empty strings gracefully.
            strOut = strOut & Mid$(strMapOut, lngPos, 1)
        Else
            strOut = strOut & strChar
        End If
    Next lngI
End If
dhTranslate = strOut

End Function

Product information

Author	Ken Getz
Co-author	Mike Gilbert
Form	With illustration
Language	Dutch
Size	66x239x174 mm
Weight	1,67 kg
ISBN10	9041901841
ISBN13	9789041901842

© Ken Getz en Mike Gilbert

Een variant van deze functie kreeg ik van een profi van het MrExcel forum.
Credits en ©: Rick Rothstein
Dit is een zeer verkorte versie met dezelfde werking.

Function rrTranslate(ByVal strIn As String, _
ByVal strMapIn As String, _
ByVal strMapOut As String, _
Optional lngCompare As VbCompareMethod = vbBinaryCompare) As String
Dim x As Long
    For x = 1 To Len(strMapIn)
        strIn = Replace(strIn, Mid(strMapIn, x, 1), _
        Mid(strMapOut, Application.Max(1, Application.Min(x, Len(strMapOut))), 1))
    Next
    rrTranslate = strIn
End Function