时间戳

首页 > 解决方案 > Excel用户定义函数接受单元格范围的命名范围intsead

excel - Excel用户定义函数接受单元格范围的命名范围intsead

问题描述

已按照一些说明创建用户定义的函数以在最新版本的 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

标签： excelvbanamed-ranges

解决方案

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

编辑： 添加的功能 - 如果一个参数可以被评估为范围，它将被转换为范围：如果名称THENAME被定义，=TXTJOIN("/","THENAME",C1:C3,"Fourth",777)并=TXTJOIN("/",THENAME,C1:C3,"Fourth",777)输出相同的结果

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：已完成重构，添加了 skipEmpty，修复了名称问题

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

推荐阅读