Следующая подпрограмма VBA работает, хотя я думаю, что существует более эффективный алгоритм.
Это написано как функция.
- Объедините две строки в одну
- Существует ли первый символ в строке более одного раза
- Если нет, проверьте следующий символ
- Если это так, удалите все соответствующие символы
- Повторяйте, пока все символы не будут проверены
Для этого я использую рекурсивную подпрограмму, с которой у меня мало опыта. Но, похоже, он возвращает желаемый результат.
Option Explicit
Option Compare Text
Function UniqueChars(s1 As String, s2 As String)
Dim S As String
S = s1 & s2
RemoveDups S, 1
UniqueChars = UCase(S)
End Function
Sub RemoveDups(ByRef S As String, ByVal NDX As Long)
Dim Ltr As String * 1
If NDX > Len(S) Then Exit Sub
Ltr = Mid(S, NDX)
If Len(S) = Len(Replace(S, Ltr, "")) + 1 Then 'unique character
NDX = NDX + 1
Else
S = Replace(S, Ltr, "")
End If
RemoveDups S, NDX
End Sub
Обратите внимание, что если вы не хотите использовать Option Compare Text
для модуля, вы можете указать режим сравнения в качестве необязательного аргумента отдельно в функции VBA Replace
. Я не уверен, что является более эффективным.