请教下如何每隔几行将内容拼接在同一个单元格中

ccvvccvv

请教下各位老师，如何将B列姓名中的数据，每隔4行拼接在一个单元格中，同时还要判断A列学院是否相同，如果不同的话，也不能在拼接在一起。最终想要的效果如C列所示，谢谢！请各位老师不吝赐教！

苏小亓

1. Sub ConcatenateNames()
   
2.     Dim ws As Worksheet
   
3.     Dim lastRow As Long
   
4.     Dim i As Long
   
5.     Dim college As String
   
6.     Dim tempNames As String
   
7.     Dim count As Long
   
8.     Dim outputRow As Long
   
9.    
   
10.     Set ws = ThisWorkbook.Sheets("Sheet1")
    
11.     lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row
    
12.     outputRow = 2 ' 从第二行开始输出结果
    
13.    
    
14.     college = ws.Cells(2, 1).Value ' 初始化学院
    
15.     tempNames = ""
    
16.     count = 0
    
17.    
    
18.     For i = 2 To lastRow ' 从第二行开始遍历
    
19.         If ws.Cells(i, 1).Value <> college Then
    
20.             ' 如果学院不同，输出当前结果并重置
    
21.             ws.Cells(outputRow, 3).Value = tempNames
    
22.             outputRow = outputRow + 1
    
23.             tempNames = ""
    
24.             count = 0
    
25.             college = ws.Cells(i, 1).Value
    
26.         End If
    
27.         
    
28.         If count < 4 Then
    
29.             ' 拼接姓名
    
30.             If tempNames = "" Then
    
31.                 tempNames = ws.Cells(i, 2).Value
    
32.             Else
    
33.                 tempNames = tempNames & ", " & ws.Cells(i, 2).Value
    
34.             End If
    
35.             count = count + 1
    
36.         Else
    
37.             ' 如果达到4个，输出并重置
    
38.             ws.Cells(outputRow, 3).Value = tempNames
    
39.             outputRow = outputRow + 1
    
40.             tempNames = ws.Cells(i, 2).Value
    
41.             count = 1
    
42.         End If
    
43.     Next i
    
44.    
    
45.     ' 处理最后一批数据
    
46.     If tempNames <> "" Then
    
47.         ws.Cells(outputRow, 3).Value = tempNames
    
48.     End If
    
49.    
    
50.     MsgBox "拼接完成！"
    
51. End Sub
    

复制代码

mjm04

一步到位的

=IFNA(REDUCE({"学院","姓名"},UNIQUE(A2:A16),LAMBDA(a,b,VSTACK(a,HSTACK(b,BYROW(WRAPROWS(FILTER(B2:B16,b=A2:A16,""),4,""),LAMBDA(x,TEXTJOIN("，",1,x))))))),"")

ccvvccvv

mjm04 发表于 2025-3-21 16:31
一步到位的

=IFNA(REDUCE({"学院","姓名"},UNIQUE(A2:A16),LAMBDA(a,b,VSTACK(a,HSTACK(b,BYROW(WRAPROW ...

已经完美解决了问题，谢谢老师！应用了好多新函数，得好好消化，学习。

yuppice

=REDUCE(,DROP(GROUPBY(A2:A16,B2:B16,LAMBDA(x,BYROW(WRAPROWS(x,4,""),LAMBDA(y,TEXTJOIN(",",,y)))),0,0),,1),VSTACK)

沈默00

练习一下创建辅助列....
=CHOOSECOLS(GROUPBY(HSTACK(A2:A16,MAP(A2:A16,LAMBDA(x,QUOTIENT(COUNTIF($A$2:x,x)-1,4)+1))),B2:B16,ARRAYTOTEXT,0,0),1,3)

飞天篮球猪

仅供参考...

Excel_muke

试试

1. =LET(a,DROP(REDUCE("",UNIQUE(A2:A16),LAMBDA(x,y,VSTACK(x,WRAPROWS(FILTER(B2:B16,A2:A16=y),4,"")))),1),MAP(a,LAMBDA(x,TEXTJOIN(",",1,IF(ISTEXT(x),x,"")))))

复制代码

mengrs

=DROP(REDUCE("",UNIQUE(A2:A16),LAMBDA(x,y,VSTACK(x,BYROW(WRAPROWS(TOROW(IF(A2:A16=y,B2:B16,0/0),3),4,""),LAMBDA(z,TEXTJOIN(",",,z)))))),1)