如何将主表的数据自动分配到子表

51065942

主表中的数据根据姓名对应分配到子表中的姓名下的对应行数中生成 测试公式.rar (8.91 KB, 下载次数: 8)

2023-2-8 21:20 上传

点击文件名下载附件

主表中的姓名会有不定时变动，

liulang0808

Sub 按钮1_Click()
    Set d = CreateObject("scripting.dictionary")
    Application.ScreenUpdating = False
    arr = Sheets("主表").UsedRange
    For j = 3 To UBound(arr)
        If Len(arr(j, 1)) > 0 Then
            For i = 5 To UBound(arr, 2)
                If Len(arr(j, i)) > 0 Then
                    If Not d.exists(arr(j, i)) Then
                        Set d(arr(j, i)) = CreateObject("scripting.dictionary")
                    End If
                    Set d(arr(j, i))(arr(j, 1)) = Sheets("主表").Cells(j, 2).Resize(1, 3)
                End If
            Next i
        End If
    Next j
    With Sheets("子表")
        .UsedRange.Clear
        r = 1
        For Each k In d.keys
            .Cells(r, 1) = "数据统计"
            .Cells(r, 2).Resize(1, 3).Merge
            .Cells(r, 2) = k
            For Each kk In d(k).keys
                r = r + 1
                .Cells(r, 1) = kk
                .Cells(r, 2).Resize(1, 3).Value = d(k)(kk).Value
            Next kk
            r = r + 3
        Next k
        .UsedRange.HorizontalAlignment = xlCenter
        .UsedRange.VerticalAlignment = xlCenter
        .UsedRange.Borders.LineStyle = xlContinuous
    End With
    Application.ScreenUpdating = True
End Sub

liulang0808

格式做了微调，供参考