使 VBA udf 与数组公式兼容答案

【问题标题】：Making VBA udf compatible with Array Formula使 VBA udf 与数组公式兼容
【发布时间】：2020-02-06 14:48:04
【问题描述】：

我发现以下伟大的 udf 用于模糊匹配字符串，但它不适用于数组公式，我在 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

【问题讨论】：

标签： excel vba

【解决方案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

【讨论】：