根据同一组合编码内的产品编码的合计数量回填值

XXZSP2

请教大佬，我想根据同一组合编码内的产品编码的合计数量回填值，附件的代码改来改去都不对，麻烦大佬帮忙看看，非常感谢。

扇扇扇

Sub test()

Dim d As Object
Dim i%, j%, lr%, mysum%
Dim arr, brr
Dim s1, s2
Dim sh As Worksheet, sht As Worksheet

Application.ScreenUpdating = False: Application.DisplayAlerts = False

Set sh = Worksheets("订单模板"): Set sht = Worksheets("活动时间1")

lr = sh.Cells(Rows.Count, 2).End(3).Row

arr = sh.Range("B2:S" & lr): brr = sht.[a1].CurrentRegion

If arr(1, 4) < brr(1, 2) Or arr(1, 4) > brr(1, 4) Then
    Exit Sub
End If

Set d = CreateObject("scripting.dictionary")

For i = 3 To UBound(brr)
    s = brr(i, 1) & brr(i, 2)
    If Not d.exists(s) Then
        d(s) = Array(brr(i, 5), brr(i, 6), brr(i, 7))
    End If
Next

For i = 7 To UBound(arr)
    s1 = arr(1, 15) & arr(i, 1)
    mysum = arr(i, 9)
    For j = i + 1 To UBound(arr)
        s2 = arr(1, 15) & arr(j, 1)
        If d(s1)(2) = d(s2)(2) Then
            mysum = mysum + arr(j, 8)
        Else
        Exit For
        End If
    Next
    If mysum >= d(s1)(0) Then
        For m = i To j - 1
            arr(m, 17) = d(s1)(1)
        Next
    End If
Next
sh.[b2].Resize(UBound(arr), UBound(arr, 2)) = arr
Set d = Nothing
Application.ScreenUpdating = True: Application.DisplayAlerts = True
MsgBox "完成"
End Sub

扇扇扇

扇扇扇

图片不用审核，你自己验证一下

XXZSP2

扇扇扇 发表于 2024-8-24 18:39

可能是我表述需求不够清楚，R列没有回填值。不过，还是非常感谢帮助。

扇扇扇

符合条件的R列不是有回填吗

XXZSP2

扇扇扇 发表于 2024-8-26 16:27
符合条件的R列不是有回填吗

嗯嗯，我也没能找出为什么没有回填值的原因。不管怎样，还是非常非常感谢。

扇扇扇

或许是因为你有的WPS

XXZSP2

扇扇扇 发表于 2024-8-27 10:31
或许是因为你有的WPS

哦哦，是的，我用的是WPS。

XXZSP2

扇扇扇 发表于 2024-8-27 10:31
或许是因为你有的WPS

大佬，您好！我在您给的代码上稍微做了下修改，如附件。但是有些有订单数量的产品编码没有在活动时间之列的话，也回填值了，是错误的。能否麻烦大佬有空的时候帮忙看看，我是哪里改错了呢？非常感谢！