求直接根据名称对应数量填入对应地址的表内，感谢！

201403201403

蓝桥玄霜

门店的例子：

jjmysjg

蓝桥玄霜 发表于 2024-3-6 10:24
门店的例子：

点击次数多，累加了，如何简化这个代码

Sheet1.Range("B2:B65").ClearContents
Sheet2.Range("B2:B65").ClearContents
Sheet3.Range("B2:B65").ClearContents
Sheet4.Range("B2:B65").ClearContents
Sheet5.Range("B2:B65").ClearContents

201403201403

蓝桥玄霜 发表于 2024-3-6 10:24
门店的例子：

麻烦问一下，运行后计算统计数量不对，是何原因

yynrzwh

附件1_.zip (18 KB, 下载次数: 2)

2024-3-6 18:59 上传

点击文件名下载附件

gwjkkkkk

Option Explicit
Sub TEST0()
    Dim ar, br, cr, i&, j&, dic(1) As New Dictionary, vKey
   
    Application.ScreenUpdating = False
     
    ar = Sheets("Sheet1").[A1].CurrentRegion.Value
    For i = 2 To UBound(ar)
        If Len(ar(i, 3)) Then
            dic(0)(ar(i, 4)) = dic(0)(ar(i, 4)) & " " & i
        End If
    Next i
   
    On Error Resume Next
    For Each vKey In dic(0).keys
        dic(1).RemoveAll
        cr = Split(dic(0)(vKey))
        For i = 1 To UBound(cr)
            dic(1)(ar(cr(i), 3)) = dic(1)(ar(cr(i), 3)) + 1
        Next i
        With Sheets(vKey)
            With .[A1].CurrentRegion
                br = .Value
                For i = 2 To UBound(br)
                    br(i, 2) = dic(1)(br(i, 1))
                Next i
                .Value = br
            End With
        End With
    Next
   
    Erase dic
    Application.ScreenUpdating = True
    Beep
   
End Sub

gwjkkkkk

请参考 。。。。