非常紧急,不完成下不了班啦,求大神

好多年

现在有一份按照班级排序的总名单，要转换成每个班级一块，第一行是班级名称，第二行开始每行10个名字，第三行也是10个，但是每个班的人数不一定，在最后一行下面加一行空行，类似于分类汇总。

zwzc

=DROP(IFNA(REDUCE("",UNIQUE(A2:A48),LAMBDA(x,y,VSTACK(x,y,WRAPROWS(TAKE(FILTER(A2:B48,A2:A48=y),,-1),10,""),""))),""),1)



用新版本wps或office365可以直接出结果。

dambcer

cnmlgb9998

来个不一样的方案。PQ解决。一劳永逸

leepoison

=IFNA(DROP(REDUCE("",UNIQUE(A2:A48),LAMBDA(x,y,VSTACK(x,VSTACK(VSTACK(y,WRAPROWS(FILTER(B2:B48,A2:A48=y),10),""))))),1),"")

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar, br, i&, j&, r&, dic As Object, vKey
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    ar = [A1].CurrentRegion.Value
    For i = 2 To UBound(ar)
        dic(ar(i, 1)) = dic(ar(i, 1)) & "," & ar(i, 2)
    Next i
   
    ReDim br(1 To UBound(ar), 1 To 10)
    For Each vKey In dic.keys
        ar = Split(dic(vKey), ",")
        ar = transArrToRow(ar, 10, 1, UBound(ar))
        r = r + 1
        br(r, 1) = vKey
        For i = 1 To UBound(ar)
            r = r + 1
            For j = 1 To UBound(ar, 2)
                br(r, j) = ar(i, j)
            Next j
        Next i
        r = r + 1
    Next
   
    Columns("F:O").Clear
    [f1].Resize(r, UBound(br, 2)) = br
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub
Function transArrToRow(ByVal ar, ByVal iCutNum&, _
    ByVal iStartCol&, ByVal iEndCol&) As Variant()
    Dim br, j&, n&, y&, x&, iColSize&
   
    If iStartCol < LBound(ar) Then iStartCol = LBound(ar)
    If iEndCol > UBound(ar) Then iEndCol = UBound(ar)

    n = -(Int(-(iEndCol - iStartCol + 1) / iCutNum))
    iColSize = IIf(iEndCol - iStartCol + 1 < iCutNum, iEndCol - iStartCol + 1, iCutNum)
    ReDim br(1 To n, 1 To iColSize)

    n = 0
    For j = iStartCol To iEndCol
        n = n + 1
        y = -Int(-n / iCutNum)
        x = IIf(n Mod iCutNum = 0, iCutNum, n Mod iCutNum)
        br(y, x) = ar(j)
    Next j
    transArrToRow = br
End Function

edwin11891

1. =IFNA(DROP(REDUCE("",UNIQUE(A2:A48),LAMBDA(x,y,VSTACK(x,LET(sname,FILTER(B2:B48,A2:A48=y),VSTACK(y,TRANSPOSE(WRAPCOLS(sname,10)),""))))),1),"")

复制代码

gwjkkkkk

请参考附件。。。

wtzxuexivba

=WRAPROWS(FILTER(B2:B48,A2:A48="A"),10,"")

好多年

感谢各位大神，方案都很全，