请问如何用VBA实现如下效果：在“组件工作表里，按A列重复值计数，例如S4Z030130的...

新一一

请问如何用VBA实现如下效果：在“组件工作表里，按A列重复值计数，例如S4Z030130的计数是5,那么在“总表工作表里出现S4Z030130的位置插入计数值的行数，并复制S4Z030130对应的物料在刚刚插入的位置上，以此类推。


请大神帮快看看，万分感谢。

3190496160

工作簿2581 - 副本.rar (171.79 KB, 下载次数: 3)

2022-12-3 19:55 上传

点击文件名下载附件

3190496160

Sub qushu()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("组件")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 2 Then MsgBox "组件为空！": End
    ar = .Range("a1:c" & r)
End With
For i = 2 To UBound(ar)
    If Trim(ar(i, 1)) <> "" Then
        If Not d.exists(Trim(ar(i, 1))) Then
             d(Trim(ar(i, 1))) = ar(i, 2)
        Else
             d(Trim(ar(i, 1))) = d(Trim(ar(i, 1))) & "|" & ar(i, 2)
        End If
    End If
Next i
With Sheets("总表")
    rs = .Cells(Rows.Count, 1).End(xlUp).Row
    br = .Range("a1:c" & r)
    ReDim arr(1 To 100000, 1 To 3)
    For i = 2 To UBound(br)
        If Trim(br(i, 2)) <> "" Then
            If d.exists(Trim(br(i, 2))) Then
                rr = Split(d(Trim(br(i, 2))), "|")
                n = n + 1
                For j = 1 To UBound(br, 2)
                    arr(n, j) = br(i, j)
                Next j
                For s = 0 To UBound(rr)
                    n = n + 1
                    arr(n, 2) = rr(s)
                    arr(n, 3) = "取消"
                Next s
            End If
        End If
    Next i
     .Range("a2:c" & r + 1) = Empty
     .[a2].Resize(n, UBound(arr, 2)) = arr
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

新一一

谢谢大神，超级感谢