Обеспечение совместимости VBA udf с Array Formula

Question

Я нашел следующий отличный udf для нечеткого соответствия строки, но он не работает с формулой Array, я очень c в VBA и не могу заставить его работать (при чтении другого поста он может иметь какое-то отношение к добавлению Lbound где-нибудь, но не могу понять).

Могу ли я получить помощь?

я хотел бы сделать что-то вроде

{=searchChars("yellow",if(list_of_product="productA",list_of_colors))}

.

    'Name function and arguments
Function SearchChars(lookup_value As String, tbl_array As Variant) As String
'Declare variables and types
Dim i As Integer, str As String, Value As String
Dim a As Integer, b As Integer, cell As Variant
'Iterste through each cell
For Each cell In tbl_array
  'Save cell value to variable
  str = cell
  'Iterate through characters
  For i = 1 To Len(lookup_value)
    'Same character?
    If InStr(cell, Mid(lookup_value, i, 1)) > 0 Then
      'Add 1 to number in array
      a = a + 1
      'Remove evaluated character from cell and contine with remaning characters
      cell = Mid(cell, 1, InStr(cell, Mid(lookup_value, i, 1)) - 1) & Mid(cell, InStr(cell, Mid(lookup_value, i, 1)) + 1, 9999)
    End If
  'Next character
  Next i

a = a - Len(cell)
'Save value if there are more matching characters than before
If a > b Then
  b = a
  Value = str
End If

a = 0
Next cell
'Return value with the most matching characters
SearchChars = Value
End Function

Option Explicit

Answer 1

Работает нормально для меня - не нужно вводить в виде формулы массива:

Несколько «улучшений»:

Function SearchChars(lookup_value As String, tbl_array As Variant) As String
    Dim i As Long, str As String, Value As String, c As String
    Dim a As Long, b As Long, cell As Variant

    For Each cell In tbl_array
        If Len(cell) > 0 Then 'skip empty values
            str = cell
            a = 0
            For i = 1 To Len(lookup_value)
                c = Mid(lookup_value, i, 1) '<< do this once
                If InStr(cell, c) > 0 Then
                    a = a + 1
                    cell = Replace(cell, c, "", Count:=1) '<< simpler
                    If Len(cell) = 0 Then Exit For        '<< nothing left...
                End If
            Next i

            a = a - Len(cell)
            'Debug.Print str, a
            If a > b Then
                b = a
                Value = str
            End If
        End If
    Next cell

    SearchChars = Value
End Function