如何将excel表中符合某些条件的数据自动汇总到指定单元格中

woshifanlei

根据附件，将日期为2020-04-01的号码依次填入到B至K列，换行，将日期2020-04-02的号码依次填入到B至K列，依次类推。

老骥705664849

Sub test()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With ActiveSheet
    r = .Cells(Rows.Count, 18).End(xlUp).Row
    ar = .Range("r1:s" & r)
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" And Trim(ar(i, 2)) <> "" Then
            If d(Trim(ar(i, 2))) = "" Then
                d(Trim(ar(i, 2))) = ar(i, 1)
            Else
                d(Trim(ar(i, 2))) = d(Trim(ar(i, 2))) & "|" & ar(i, 1)
            End If
        End If
    Next i
    For Each k In d.keys
        rr = Split(d(k), "|")
        m = UBound(rr)
        If m <= 9 Then
            rs = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Cells(rs, 1) = k
            For j = 0 To m
                .Cells(rs, j + 2) = rr(j)
            Next j
        ElseIf m > 9 Then
            For j = 0 To m Step 10
                rs = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                .Cells(rs, 1) = k
                y = 1
                For s = j To j + 9
                    y = y + 1
                    If s > m Then GoTo 10
                 .Cells(rs, y) = rr(s)
                Next s
10:
            Next j
        End If
    Next k
End With
End Sub

老骥705664849

汇总.rar (115.25 KB, 下载次数: 6)

2020-6-16 15:36 上传

点击文件名下载附件

woshifanlei

老骥705664849 发表于 2020-6-16 15:36

高手 感谢                        

老骥705664849

woshifanlei 发表于 2020-6-16 16:24
高手 感谢

有用清送朵小花