函数解决不了，求助VBA大神

335356119

查询.rar (6.36 KB, 下载次数: 8)

2018-9-15 14:54 上传

点击文件名下载附件

iwangyi

Sub cc()
m = 2
Set d = CreateObject("scripting.dictionary")
Set dd = CreateObject("scripting.dictionary")
arr = Sheets("数据表").UsedRange
For i = 2 To UBound(arr)
d(arr(i, 2) & "-" & arr(i, 3)) = d(arr(i, 2) & "-" & arr(i, 3)) + arr(i, 5)
Next
Stop
brr = Application.Transpose(Array(d.keys, d.items))
For j = 1 To UBound(brr)
   s = Split(brr(j, 1), "-")(1)
   If Not dd.exists(s) Then
   m = m + 1
   dd(s) = m
   Cells(m, 1) = Split(brr(j, 1), "-")(0): Cells(m, 3) = brr(j, 2): Cells(m, 5) = Cells(m, 3) / Cells(m, 4): Cells(m, 6) = Split(brr(j, 1), "-")(1)
   Else
   Cells(dd(s), 1) = Cells(dd(s), 1) & "/" & Split(brr(j, 1), "-")(0)
   Cells(dd(s), 3) = Cells(dd(s), 3) & "/" & brr(j, 2)
   Cells(dd(s), 5) = Cells(dd(s), 5) & "/" & brr(j, 2) / Cells(m, 4)
   End If
Next
End Sub

iwangyi

附件，请参考

longming3

Sub aa()
    ar = Sheets("数据表").Range("a1").CurrentRegion
    With Sheets("VBA查询")
        cxrq = .[a1]
        Set d = CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(ar)
            If ar(i, 1) = cxrq Then
                s = ar(i, 2) & "#" & ar(i, 5)
                d(ar(i, 3)) = d(ar(i, 3)) & "/" & s
            End If
        Next
        kk = d.keys: tt = d.items
        ReDim br(1 To UBound(ar), 1 To 6)
        For i = 0 To d.Count - 1
            k = k + 1
            w = ""
            x = Split(tt(i), "/")
            For j = 1 To UBound(x)
                m = Split(x(j), "#")
                If w <> "" And w <> m(0) Then
                    br(k, 1) = br(k, 1) & "/" & m(0)
                    br(k, 3) = br(k, 3) & "/" & m(1)
                    br(k, 4) = br(k, 4) + 1
                    fj = Split(br(k, 3), "/")
                    For y = 0 To UBound(fj)
                        cl = cl & "/" & Val(fj(y)) / br(k, 4)
                    Next
                    br(k, 5) = Mid(cl, 2, Len(cl) - 1)
                    br(k, 6) = kk(i)
                    cl = ""
                Else
                    br(k, 1) = m(0)
                    br(k, 3) = br(k, 3) + Val(m(1))
                    br(k, 4) = br(k, 4) + 1
                    br(k, 5) = br(k, 3) / br(k, 4)
                    br(k, 6) = kk(i)
                End If
                w = br(k, 1)
            Next
        Next
        .[j3].Resize(k, 6) = br
    End With
End Sub

335356119

iwangyi 发表于 2018-9-15 16:56
附件，请参考

这个好像有报错

longming3

代码重新修改了一下，考虑到同一天可能会出现更多次的产品规格

longming3

附件，看一下是否是这样的效果

335356119

longming3 发表于 2018-9-15 17:28
附件，看一下是否是这样的效果

挺好的，请问能否做能，相同规格次数的合并计算呢？比如3030(3），同组同天，需要合并在一起计算，产量相加，和其他次数/其他规格的区分开

不知道为什么

335356119 发表于 2018-9-15 17:34
挺好的，请问能否做能，相同规格次数的合并计算呢？比如3030(3），同组同天，需要合并在一起计算，产量相 ...

如图，字典套嵌来处理试试

不知道为什么

335356119 发表于 2018-9-15 17:34
挺好的，请问能否做能，相同规格次数的合并计算呢？比如3030(3），同组同天，需要合并在一起计算，产量相 ...