写个文本合并函数练习，类似TEXTJOIN,老师们请勿笑话

ggmmlol

cjc209 发表于 2020-12-1 21:27
内置的第一参数 可以为数组 这个不行 怎么改?

把第1参数的类型改为Validation，在代码中用Isarray函数判断后分别处理。

cjc209

ggmmlol 发表于 2020-12-2 08:29
把第1参数的类型改为Validation，在代码中用Isarray函数判断后分别处理。

谢谢 我试一试

cjc209

ggmmlol 发表于 2020-12-2 08:29
把第1参数的类型改为Validation，在代码中用Isarray函数判断后分别处理。

改写不来 我试了一下 始终都是错误

cjc209

ggmmlol 发表于 2020-12-2 08:29
把第1参数的类型改为Validation，在代码中用Isarray函数判断后分别处理。

过程形式 就可以
改写成函数 就不知道怎么带参数进入了 就是难在分给符参数
Sub TEXTJOIN1()    'Variant  '联结文本
    Dim tmptext As Variant, Rng As Variant, cel As Variant
    tmptext = ""
    Delimiter = [{"-","#"}]
    args = [a1:h1]
    gs = UBound(args, 1)
    For Each Rng In args
       If Rng <> "" Then
            If IsArray(Delimiter) Then
              If i = 0 Then
                If Len(Rng) Or Not ignore_empty Then tmptext = Rng
                Else
                tmptext = tmptext & Delimiter(i) & Rng
                End If
             End If
       On Error Resume Next
       a = Error(Delimiter(i + 1))
       i = i + 1
       If Err.Number = 9 Then i = 1
      End If
    Next
    TEX = tmptext
End Sub

cjc209

如果能改写成功 就是真正的textjoin 了

niko88819

留下脚印,收藏学习,太棒了

niko88819

cjc209 发表于 2020-12-2 10:36
如果能改写成功 就是真正的textjoin 了

老师,您有进展吗?期待您的佳作

cjc209

niko88819 发表于 2020-12-16 10:30
老师,您有进展吗?期待您的佳作

我写出来了
Function 文本连接(分隔符组, 忽略空值, ParamArray 引用或数组() As Variant) As Variant
    '第一参数为分隔符,后续会可选多区域多类型,空值将被忽略
    '可传递内存数组参数
    Dim tmptext As Variant, i As Variant, cellv As Variant
    Dim cell As Range
    tmptext = ""
    sz = IsArray(分隔符组)
    If sz Then sb = UBound(分隔符组)
    If Not sz Then
        For i = 0 To UBound(引用或数组) '遍历参数数组
            If Not IsMissing(引用或数组(i)) Then '判断参数是否有效
                Select Case Right(TypeName(引用或数组(i)), 2) '对不同的参数类型采取不同的处理方式,数组类型可能有多种类型,所以判断最后一个字符
                    Case "ge" 'Range单元格区域类型,直接遍历
                        For Each cell In 引用或数组(i)
                            If 忽略空值 = 0 Then GoTo 1
                            If cell <> "" Then
1
                                If k = 0 Then
                                    tmptext = cell.Value
                                    k = k + 1
                                Else
                                    tmptext = tmptext & 分隔符组 & cell.Value
                                    k = k + 1
                                End If
                                If 忽略空值 = 0 Then GoTo 2
                            End If
2
                        Next cell
                    Case "()"  '数组类型,
                        For Each cellv In 引用或数组(i)
                            If 忽略空值 = 0 Then GoTo 3
                            If cellv <> "" Then
3
                                If k = 0 Then
                                    tmptext = cellv
                                    k = k + 1
                                Else
                                    tmptext = tmptext & 分隔符组 & cellv
                                    k = k + 1
                                End If
                                If 忽略空值 = 0 Then GoTo 4
                            End If
4
                        Next cellv
                    Case Else '其他类型,即单个值参数
                        If 忽略空值 = 0 Then GoTo 5
                        If 引用或数组(i) <> "" Then
5
                            If k = 0 Then
                                tmptext = 引用或数组(i)
                                k = k + 1
                            Else
                                tmptext = tmptext & 分隔符组 & 引用或数组(i)
                                k = k + 1
                            End If
                            If 忽略空值 = 0 Then GoTo 6
                        End If
6
                End Select
            End If
        Next i
    Else
        For i = 0 To UBound(引用或数组) '遍历参数数组
            If Not IsMissing(引用或数组(i)) Then '判断参数是否有效
                Select Case Right(TypeName(引用或数组(i)), 2) '对不同的参数类型采取不同的处理方式,数组类型可能有多种类型,所以判断最后一个字符
                    Case "ge" 'Range单元格区域类型,直接遍历
                        For Each cell In 引用或数组(i)
                            If 忽略空值 = 0 Then GoTo 7
                            If cell <> "" Then
7
                                If k = 0 Then
                                    tmptext = cell.Value
                                    k = k + 1
                                Else
                                    kk = k Mod sb
                                    If kk = 0 Then kk = sb
                                    tmptext = tmptext & 分隔符组(kk) & cell.Value
                                    k = k + 1
                                End If
                                If 忽略空值 = 0 Then GoTo 8
                            End If
8
                        Next cell
                    Case "()"  '数组类型,
                        For Each cellv In 引用或数组(i)
                            If 忽略空值 = 0 Then GoTo 9
                            If cellv <> "" Then
9
                                If k = 0 Then
                                    tmptext = cellv
                                    k = k + 1
                                Else
                                    kk = k Mod sb
                                    If kk = 0 Then kk = sb
                                    tmptext = tmptext & 分隔符组(kk) & cellv
                                    k = k + 1
                                End If
                                If 忽略空值 = 0 Then GoTo 10
                            End If
10
                        Next cellv
                    Case Else '其他类型,即单个值参数
                        If 忽略空值 = 0 Then GoTo 11
                        If 引用或数组(i) <> "" Then
11
                            If k = 0 Then
                                tmptext = 引用或数组(i)
                                k = k + 1
                            Else
                                kk = k Mod sb
                                If kk = 0 Then kk = sb
                                tmptext = tmptext & 分隔符组(kk) & 引用或数组(i)
                                k = k + 1
                            End If
                            If 忽略空值 = 0 Then GoTo 12
                        End If
12
                End Select
            End If
        Next i
    End If
    文本连接 = tmptext
End Function
和Excel高版本的textejoin 完全一样的应用

niko88819

老师,您太厉害了,太棒了,对小师妹来说没有高版本,用您方法写出公式解决2019同样的功能
对没有高版本,又想解高版的问题,总算解决了,这样可以借用老师的手帮助更多朋友. 因为写出来公式就是等于高版本公式.

micch

一直没用过高版，也不知道textjoin到底有哪些功能。说重写代码一直没重写。回头抽空学习一下  cjc209 老师的代码，重写一个