Excel 用户定义的函数接受命名范围而不是单元格范围

Question

已按照一些说明创建用户定义函数以复制 Excel 最新版本中的 TEXTJOIN 函数。它可以创建一个函数，您可以像使用任何其他函数一样使用该函数，将单元格范围的内容输出到单个单元格，以逗号分隔。

这很好用，但是我无法让这个函数接受命名范围而不是单元格范围。这可能吗？

语法如下： =My_Text_Join(“,”,1, name-of-namedrange)

Option Explicit
Function My_Text_Join(delimiter As String, ignore_empty As Boolean, text_range As Range) As String

Application.Volatile
Dim c As Range
Dim n As Long
n = 0
For Each c In text_range
 If ignore_empty = True Then
 If VBA.IsEmpty(c.Value) = False Then
 If n = 0 Then
 My_Text_Join = c.Value
 Else
 My_Text_Join = My_Text_Join & delimiter & c.Value
 End If
 n = n + 1
 End If
 
 Else
 
 If n = 0 Then
 My_Text_Join = c.Value
 Else
 My_Text_Join = My_Text_Join & delimiter & c.Value
 End If
 n = n + 1
 
 End If
Next

End Function

Answer 1

试试这个代码（可以接受不同类型的可变数量的参数——连续或不连续的范围、名称、常量；例如 =TXTJOIN("/",THENAME,C1:C3,"Fourth",777):

Edit: Added feature - if an argument can be evaluated as Range, it will be converted to Range: if name THENAME was defined, =TXTJOIN("/","THENAME",C1:C3,"Fourth",777) and =TXTJOIN("/",THENAME,C1:C3,"Fourth",777) outputs the same result

Option Explicit

Public Function TXTJOIN(Delimiter As String, ParamArray args() As Variant)
    Dim A As Variant, cl As Range
    TXTJOIN = vbNullString
    For Each A In args
        On Error Resume Next
        Set A = Names(A).RefersToRange    ' if an argument can be evaluated as Range, it will be converted to Range
        On Error GoTo 0
        Select Case TypeName(A)
            Case "Range"
                For Each cl In A
                    TXTJOIN = IIf(TXTJOIN = vbNullString, cl.Text, _
                              TXTJOIN & Delimiter & cl.Text)
                Next
            Case Else
                TXTJOIN = IIf(TXTJOIN = vbNullString, A, _
                          TXTJOIN & Delimiter & A)
        End Select
    Next
End Function

Edit2: refactoring has been done, added skipEmpty, fixed Names issue

Option Explicit

Public Function TXTJOIN(Delimiter As String, skipEmpty As Boolean, ParamArray args() As Variant) As String
    Dim A As Variant, cl As Range, buffer As String
    For Each A In args
        If TypeName(A) = "String" Then ' if an *string* argument can be evaluated as Range, it will be done
            On Error Resume Next
            Set A = Names(A).RefersToRange
            On Error GoTo 0
        End If
        If TypeName(A) = "Range" Then
            For Each cl In A
                buffer = cl.text    ' buffer is used to minimize the number of cell reads
                If Not skipEmpty Or Len(buffer) > 0 Then _
                   TXTJOIN = TXTJOIN & Delimiter & buffer
            Next cl
        Else
            If Not skipEmpty Or Len(A) > 0 Then _
                TXTJOIN = TXTJOIN & Delimiter & A
        End If
    Next A
    TXTJOIN = Mid(TXTJOIN, Len(Delimiter) + 1) ' remove lead Delimiter occur
End Function

Excel 用户定义的函数接受命名范围而不是单元格范围

Excel user defined function to accept named range intsead of cell range

excel

vba

named-ranges