a) Подход через байтовый массив
В дополнение к приведенным выше действующим решениям и ради уровня техники существует другой подход с использованием байтового массива:
Sub ExampleCall()
Dim s As String: s = "100000010000100000"
Debug.Print s & " ~> " & getRole(s) ' ~> Admin, Viewer, TA
End Sub
Функция справки getRole()
Function getRole(code As String) As String
'[0]define identifying role position in code string (e.g. "100000010000100000")
Dim roles As Variant, b() As Byte
roles = Array(0, "Admin", 2, 3, 4, 5, 6, "TE", "Viewer", 9, "DEV", "TL", 12, "TA", 14, 15, 16, 17, 18)
'[1]assign code string to byte array (generates two elements per character)
b = code
'[2]get the "1" positions
Dim i As Long, role As String
For i = LBound(b) To UBound(b) - 1 Step 2 ' check the 1st element of each char pair
If b(i) = Asc("1") Then role = role & roles(Int(i / 2) + 1) & ", "
Next
role = Left(role, Len(role) - 2)
'[3]return function result
getRole = role
End Function
~~~~~~~~~~~~~~~~~~~~ Edit ~~~~~~~~~~~~~~~~~~~
b) Альтернатива через FilterXML() (Excel версии 13 +)
In Чтобы завершить весь спектр различных подходов, я продемонстрирую, как использовать функцию Worksheet FilterXML() (доступна в версиях 13+). Поскольку нет необходимости связываться с библиотекой, вы можете найти этот простой пример в качестве альтернативы словарям.
Sub ExampleCall2()
Dim code As String: code = "100000010000100000"
Debug.Print decode(code)
End Sub
Функции справки decode() и XMLRole()
Function decode(code) As String
Dim pos As Long, cnt As Long, isReady As Boolean
ReDim tmp(1 To Len(code))
Do While Not isReady
pos = InStr(pos + 1, code, "1")
If pos = 0 Then
isReady = True
Else
cnt = cnt + 1: tmp(cnt) = XMLRole(pos)
End If
Loop
ReDim Preserve tmp(1 To cnt)
decode = Join(tmp, ", ")
End Function
Function XMLRole(code) As String
Const wellformed As String = "<roles><r t='Admin'>1</r><r t='TE'>7</r><r t='Viewer'>8</r><r t='DEV'>10</r><r t='TL'>11</r><r t='TA'>13</r></roles>"
XMLRole = WorksheetFunction.FilterXML(wellformed, "//r[.=" & code & "]/@t")
End Function
Краткие подсказки для XPath
XPath Строки (здесь: "//r[.=" & code & "]/@t") позволяют искать содержимое узла или атрибута, обогащенное условиями (здесь, например: [.=11], указывающее на числовое c содержимое, например, 11) в хорошо сформированной структуре узла (сравнимой с html). Дополнительные подузлы или атрибуты добавляются / ко всему термину (здесь: содержание атрибута /@t (символизирующее тип , например, 'TL') после узла роли r; между прочим //r обозначает роль поиск любого r в любом месте после элемента root (здесь: roles).