将EXCEL表格一行按一定的要求用定义函数串成一字符串

397442484

如图EXCEL表


在A3中输入自定义函数名称和参数，自动根据第二行中“基本项”和“扣款项”（有交叉），先合并“基本项”再合并“扣款项”。效果如下：燕春科技\n[基本项目]\n序号：1\n基本工资：1000\n绩效工资：2000\n应发工资合计：3000\n[扣款项目]\n个税：100\n公积金：300\n医保：200\n扣款合计：600\n实发工资：2500\n
附件中已有一自定义函数，但只能按列合并不能按行合并；参数为（C1:C4，“\n”)。
我想实现参数为（b3,"\n"）就可以将第三行数据按上例所示合并。因为这个工资表是根据每个月工资表生成的中间工作表，列数不定，程序运行时操作人员也不能在此表中修改参数。
不要在表中设置操作按钮，前面说了这是中间工作表，程序运行时操作人员是看不到此表的。
请各位大师不吝赐教，不胜感谢！

397442484

一定要自定义函数，让自默默自动运行。

xiaoyuemt

自定义函数：

1. Function TxtJoin(rg As Range, Joinstr As String)
   
2. Dim arr
   
3. ReDim arr(rg.Count)
   
4. For i = 1 To rg.Count
   
5. arr(i - 1) = rg.Cells(i)
   
6. Next i
   
7. TxtJoin = Join(arr, Joinstr)
   
8. End Function

复制代码

引用：

1. =txtjoin(C3:K3,"\n")

复制代码

3190496160

不明白楼主的思维为什么就不想转弯呢？
自定义函数，还是函数公式，一点数据量大的话，文件就会运行很慢，甚至是卡死没商量，用代码，点击一下按钮，就那么费劲吗？？？

xiaoyuemt

这只个转换的例子，具体的你还要加字段名啥的，自己调整吧

高个子

1. Function TextJoin1(rg As Range, Joinstr As String)
   
2.     Dim arr
   
3.     ReDim arr(rg.Count)
   
4.     For i = 1 To rg.Count
   
5.         arr(i - 1) = Cells(2, i + 1) & "：" & rg.Cells(i)
   
6.     Next
   
7.     TextJoin1 = rg.Cells(2) & Joinstr & "[基本项目]" & Joinstr & Join(arr, Joinstr)
   
8. End Function
   

复制代码

397442484

谢谢，没有实现列数不定的功能。

xiaoyuemt

397442484 发表于 2023-1-4 11:45
谢谢，没有实现列数不定的功能。

在修改后的自定义函数中，rg是可以任意的区域，行、列、矩形块，都可以

supermouse24

你试试，这个是按照你的要求，输入参数（b3,"\n"）就能实现。
有个问题
这个公式不能放在同一行书写，不然会出现错误。即A3不能输入参数（b3,"\n"），只能再A4或者A2输入此参数。
我也不知道为什么。看看有没有大神能解决。


Function TxtJoin(rg As Range, Joinstr As String)
    end_col = rg.End(2).Column
    title1_arr = Cells(1, 1).Resize(1, end_col).Value
    title2_arr = Cells(2, 1).Resize(1, end_col).Value
    brr = Cells(rg.Row, 1).Resize(1, end_col).Value

    text_1 = brr(1, 3) & Joinstr
    text_1 = brr(1, 3) & Joinstr & "[基本项目]" & Joinstr & _
             title2_arr(1, 2) & "：" & brr(1, 2) & Joinstr


    For icol = 1 To UBound(title1_arr, 2)
        If title1_arr(1, icol) = "基本项" Then
            text_2 = text_2 & title2_arr(1, icol) & "：" & brr(1, icol) & Joinstr
        End If
    Next

    text_3 = "[扣款项目]" & Joinstr

    For icol = 1 To UBound(title1_arr, 2)
        If title1_arr(1, icol) = "扣款项" Then
            text_4 = text_4 & title2_arr(1, icol) & "：" & brr(1, icol) & Joinstr
        End If
    Next

    text_5 = title2_arr(1, end_col) & "：" & brr(1, end_col) & Joinstr
    text_ = text_1 & text_2 & text_3 & text_4 & text_5
    TxtJoin = text_
End Function

397442484

xiaoyuemt 发表于 2023-1-4 12:08
在修改后的自定义函数中，rg是可以任意的区域，行、列、矩形块，都可以

请发代码或附件。