求助

guanhuijun123

每所学校2个年级，每个年级4男4女，自由组合，2人一组进行对垫球比赛。如何实现通过左边录入的数据，根据右边表格标题栏分学校将同年级同组别2个人放在一个单元格，在相应字段下自动列出全部数据，并将组内2人垫球个数求和。

lws

1. =DROP(GROUPBY(HSTACK(MATCH(A1:A33&B1:B33,A1:A33&B1:B33,),A1:B33,E1:E33),HSTACK(C1:C33,F1:F33),HSTACK(ARRAYTOTEXT,SUM),3,0),1,1)

复制代码

3190496160

Sub 统计()
Dim ar As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With ActiveSheet
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 2 Then MsgBox "数据源为空！": End
    ar = .Range("a1:f" & r)
    Dim br()
    ReDim br(1 To UBound(ar), 1 To 5)
    For i = 2 To UBound(ar)
        If ar(i, 1) <> "" Then
            zd = ar(i, 1) & "|" & ar(i, 2) & "|" & ar(i, 4) & "|" & ar(i, 5)
            t = d(zd)
            If t = "" Then
                k = k + 1
                d(zd) = k
                t = k
                br(k, 1) = ar(i, 1)
                br(k, 2) = ar(i, 2)
                br(k, 4) = ar(i, 5)
            End If
            If br(t, 3) = "" Then
                br(t, 3) = ar(i, 3)
            Else
                br(t, 3) = br(t, 3) & "/" & ar(i, 3)
            End If
            br(t, 5) = br(t, 5) + ar(i, 6)
        End If
    Next i
    .[k1].CurrentRegion.Offset(1).Borders.LineStyle = 0
    .[k1].CurrentRegion.Offset(1) = Empty
    .[k2].Resize(k, UBound(br, 2)) = br
    .[k2].Resize(k, UBound(br, 2)).Borders.LineStyle = 1
End With
MsgBox "ok!"
End Sub

3190496160

求助.rar (17.53 KB, 下载次数: 2)

2024-6-27 09:59 上传

点击文件名下载附件

guanhuijun123

lws 发表于 2024-6-26 22:07

谢谢，但按您的代码，怎么显示错误。

guanhuijun123

3190496160 发表于 2024-6-27 09:59

谢谢。