Частичное существует в словаре

Метод Dictionary.Keys вернет массив, содержащий все ключи.

Функция Excel ПОИСКПОЗ позволяет выполнять поиск в массиве (в VBA ее можно назвать как Application.Match). Он поддерживает подстановочные знаки и не учитывает регистр, однако обратите внимание, что он возвращает только один результат, даже если несколько ключей в словаре соответствуют шаблону.

Объединение двух:

Dim vArr AS Variant, vMatch As Variant
vArr = dict.keys
vMatch = Application.Match("*apple*", vArr, 0)
If IsError(vMatch) Then
    MsgBox "Key Not Found", vbCritical
Else
    MsgBox vArr(vMatch-1), vbInformation 'the -1 is because the Array is Zero-Indexed, but Match returns One-Indexed results
End If

Звучит как идеальная работа для (относительно неизвестной) Filter() функции.

Sub Test()

Dim Dict As Object: Set Dict = CreateObject("Scripting.Dictionary")

Dict.Add "Apples", "Found You!"
Dict.Add "Banana", 2
Dict.Add "Cherry", 3
Dict.Add "Date", 4
Dict.Add "Elderberry", 5

r_out = Filter(Dict.Keys, "apple", 1, 1)
If UBound(r_out) > -1 Then
    'Do something with r_out, which is an array of all matched keys
    'For example, traverse filtered keys and return values:
    For i = 0 To UBound(r_out)
        Debug.Print Dict(r_out(i))
    Next
Else
    'Something if no matches are found
    Debug.Print "Bummer"
End If

End Sub

4 параметра:

• Одномерный массив строк, который Dict.Keys может предоставить;
• Строка для поиска (регистронезависима, поэтому не беспокойтесь);
• Логическое значение (или эквивалент 1), сообщающее функции, что мы хотим возвращать значения, включающие строку;
• Целое число 1 (vbTextCompare), чтобы сообщить функции, что мы хотим сравнить текст.

Я не уверен, что ты хочешь делать дальше...

Мне нравится ответ @JvdV, и его, вероятно, проще всего реализовать, но при этом он не зависит от приложения.

Мой ответ будет посвящен повышению скорости с помощью оператора Like, и я проведу сравнение с другими ответами.

Идея состоит в том, чтобы перебрать все ключи примерно так:

For Each tkey In Dict
    If tkey Like "*apple*" Then
       ...
    End If
Next tkey

Нам понадобится функция поддержки для адаптации шаблонов, если нам нужны сравнения без учета регистра. Например, If tkey Like "*apple*" Then чувствителен к регистру, а If tkey Like "*[Aa][Pp][Pp][Ll][Ee]*" Then нам нужен для сравнений без учета регистра.

Для адаптации шаблонов нам нужна следующая вспомогательная функция:

Public Function CaseInsensitivePattern(ByRef pattern As String) As String
    Dim chars As Long: chars = Len(pattern)
    Dim i As Long
    Dim j As Long
    Dim chL As String
    Dim chU As String
    '
    If chars = 0 Then Exit Function
    CaseInsensitivePattern = Space$(chars * 4) 'Init Buffer
    '
    j = 1
    For i = 1 To chars
        chL = LCase$(Mid$(pattern, i, 1))
        chU = UCase$(chL)
        If chL = chU Then
            Mid$(CaseInsensitivePattern, j) = chL
            j = j + 1
        Else
            Mid$(CaseInsensitivePattern, j) = "[" & chU & chL & "]"
            j = j + 4
        End If
    Next i
    CaseInsensitivePattern = Left$(CaseInsensitivePattern, j - 1)
End Function

Чтобы протестировать это на большом количестве элементов, я буду использовать VBA-FastDictionary вместо Scripting.Dictionary. Добавление 1 миллиона текстовых ключей с помощью Scripting.Dictionary на моем компьютере занимает около 23 секунд, а Fast Dictionary — всего около 0,65 секунды. Если вам нужна более подробная информация, есть раздел сравнительного анализа. Если вы не против подождать с добавлением элементов, продолжайте использовать Scripting.Dictionary.

Вот сравнение:

Sub TestSpeed()
    Dim i As Long
    Const iterations As Long = 1000000
    Dim t As Double
    Dim dict As New Dictionary
    Dim v As Variant
    Dim coll As Collection
    '
    'Add key-item pairs
    For i = 1 To iterations
        dict.Add "Key " & i, i
        If i Mod iterations \ 10 = 0 Then dict.Add "apple " & i, i
    Next i
    Debug.Print "Results in seconds"
    Debug.Print "------------------"
    '
    'Filter solution
    Dim arr As Variant
    t = Timer
    arr = Filter(dict.Keys, "test", True, vbTextCompare)
    Debug.Print "Filter on Dict.Keys: " & Round(Timer - t, 3)
    '
    'Match solution
    Dim vMatch As Variant
    t = Timer
    vMatch = Application.Match("*apple*", dict.Keys, 0)
    Debug.Print "Match on Dict.Keys: " & Round(Timer - t, 3)
    '
    'Pattern match case-sensitive
    Dim pattern As String: pattern = "*apple*"
    Set coll = New Collection
    t = Timer
    For Each v In dict
        If v Like pattern Then coll.Add v
    Next v
    Debug.Print "Pattern match case-sensitive on Dict (implicit keys): " & Round(Timer - t, 3)
    '
    'Pattern match case-insensitive
    Dim patternI As String: patternI = CaseInsensitivePattern(pattern)
    Set coll = New Collection
    t = Timer
    For Each v In dict
        If v Like patternI Then coll.Add v
    Next v
    Debug.Print "Pattern match case-insensitive on Dict (implicit keys): " & Round(Timer - t, 3)
    '
    'Pattern match case-sensitive on keys array
    Set coll = New Collection
    t = Timer
    For Each v In dict.Keys
        If v Like pattern Then coll.Add v
    Next v
    Debug.Print "Pattern match case-sensitive on Dict.Keys: " & Round(Timer - t, 3)
End Sub

На моем компьютере Win VBA7 x64 я получаю следующие результаты в окне интерпретации:

Results in seconds
------------------
Filter on Dict.Keys: 0.309
Match on Dict.Keys: 0.133
Pattern match case-sensitive on Dict (implicit keys): 0.074
Pattern match case-insensitive on Dict (implicit keys): 0.133
Pattern match case-sensitive on Dict.Keys: 0.098

Обратите внимание, что подход Match возвращает только первый найденный результат, тогда как все остальные возвращают все совпадения либо в массиве, либо в результате коллекции.