首页
学习
活动
专区
工具
TVP
发布
社区首页 >问答首页 >如何在允许数组输入的VBA UDF中复制Excel的TEXTJOIN函数

如何在允许数组输入的VBA UDF中复制Excel的TEXTJOIN函数
EN

Stack Overflow用户
提问于 2018-06-08 23:34:12
回答 1查看 7.8K关注 0票数 -31

如果我在不同的单元格中有不同的值,我如何用自己选择的分隔符(如",“或"|”等)将它们连接在一起。

例如:

所以,如果你有:

代码语言:javascript
复制
A1: foo
A2: bar
A3: baz

您可以键入A4:

代码语言:javascript
复制
=somefunction("",A1:A3)

你将会进入A4:

代码语言:javascript
复制
foo bar baz

此外,如果输入是数组函数的结果,比如:{foo,bar,bar}

也许UDF可以工作?

我知道在Microsoft Office 2016中有textjoin功能,但它只对Office 365订阅者可用。并且这个函数不能处理数组输入。

EN

回答 1

Stack Overflow用户

回答已采纳

发布于 2018-06-08 23:44:11

尝试这个用户定义的函数。它是非常通用的。它将接受输入硬编码字符串、单个单元格、单元格范围、数组或它们的任意混合。空白将被忽略。有关输出,请参阅照片。

代码语言:javascript
复制
Public Function TJoin(Sep As String, ParamArray TxtRng() As Variant) As String
On Error Resume Next
'Sep is the separator, set to "" if you don't want any separator. Separator must be string or single cell, not cell range
'TxtRng is the content you want to join. TxtRng can be string, single cell, cell range or array returned from an array function. Empty content will be ignored
Dim OutStr As String 'the output string
Dim i, j, k, l As Integer 'counters
Dim FinArr(), element As Variant 'the final array and a temporary element when transfering between the two arrays

'Go through each item of TxtRng(),  depending on the item type, transform and put it into FinArray()
i = 0 'the counter for TxtRng
j = 0 'the counter for FinArr
k = 0: l = 0 'the counters for the case of array from Excel array formula
Do While i < UBound(TxtRng) + 1
    If TypeName(TxtRng(i)) = "String" Then 'specified string like "t"
        ReDim Preserve FinArr(0 To j)
        FinArr(j) = "blah"
        FinArr(j) = TxtRng(i)
        j = j + 1
    ElseIf TypeName(TxtRng(i)) = "Range" Then 'single cell or range of cell like A1, A1:A2
        For Each element In TxtRng(i)
            ReDim Preserve FinArr(0 To j)
            FinArr(j) = element
            j = j + 1
        Next
    ElseIf TypeName(TxtRng(i)) = "Variant()" Then 'array returned from an Excel array formula
         For k = LBound(TxtRng(0), 1) To UBound(TxtRng(0), 1)
            For l = LBound(TxtRng(0), 2) To UBound(TxtRng(0), 2)
                ReDim Preserve FinArr(0 To j)
                FinArr(j) = TxtRng(0)(k, l)
                j = j + 1
            Next
         Next
    Else
        TJoin = CVErr(xlErrValue)
        Exit Function
    End If
i = i + 1
Loop

'Put each element of the new array into the join string
For i = LBound(FinArr) To UBound(FinArr)
    If FinArr(i) <> "" Then 'Remove this line if you want to include empty strings
    OutStr = OutStr & FinArr(i) & Sep
    End If
Next
 TJoin = Left(OutStr, Len(OutStr) - Len(Sep)) 'remove the ending separator

End Function

截图:

假设你的细胞看起来像这样:

代码语言:javascript
复制
  A                          B
1 find                       good
2 apples                     for free
3 online                     now
4 at                         from this site:
5 https://www.example.com

您可以输入一些公式,如下所示:

代码语言:javascript
复制
=tjoin(" ","please",$A$1,$A$3:$A$5)
=tjoin($A$6,$A$1:$A$5,"C1")
=tjoin(" ",IF(LEN($A$1:$A$5)>3,$A$1:$A$5,""))
=tjoin(" ",IF(LEN($A$1:$B$5)>3,$A$1:$B$5,""))

您的结果将是:

代码语言:javascript
复制
please find online at https://www.example.com
find -- apples -- online -- at -- https://www.example.com -- C1
find apples online at https://www.example.com
find good apples for free online from this site: https://www.example.com
票数 11
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/50763999

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档