指定列有数值时跨表多列值相乘并按条件求和填入对应列

anline1739

各位大神：
   附表中，1.当sheet1中本次计划数量不等于空的情况下，将对应的年度计划数量写入sheet2对应的M列，周计划数量写入sheet2的O列，2.统计的规则是sheet1年度计划数量/周度计划数量*sheet3里对应的材料数量（依据所属车间）,然后按材料编码进行汇总后填入sheet2对应列，例如：TH本次计划数量为100，ZP本次计划数量为200,则材料01在sheet2里H列（需求数量）为=100*100+200*200=50000,M列（年度生产数量）=100*500+300*200=110000,O列（周度生产数量）=20*100+50*200=17000,ZP本次计划数量为0，则不统计汇总。
     望各位有经验的多多指教。万分感谢！

ykcbf1100

表1和表2拿什么去匹配的？唯一有关联的只有产材料01，而这个在表1中有二个车间同时有。
感觉无从下手。

anline1739

ykcbf1100 发表于 2022-12-13 09:39
表1和表2拿什么去匹配的？唯一有关联的只有产材料01，而这个在表1中有二个车间同时有。
感觉无从下手。

sheet1里A列到D列才是统计的数据，后面的的都是举例说明计算过程的。计算过程其实就是当sheet1里的B列不不空时，则拿B列、C列、D列的数同时去乘sheet3里车间对应的所有材料，然后再把3个乘积的分别按编码进行求和，填入sheet2对应的列里。

anline1739

ykcbf1100 发表于 2022-12-13 09:39
表1和表2拿什么去匹配的？唯一有关联的只有产材料01，而这个在表1中有二个车间同时有。
感觉无从下手。

只考虑B列值乘积汇总的代码如下，就是增加两列我不知道怎么修改：
Sub test()
    Dim arr, brr, dic As Object, d As Object, d1 As Object
    Dim i&, j&, k, crr, temp$, num&, ik, sm, n
    arr = Sheet3.Range("A1").CurrentRegion
    crr = Sheet1.Range("A1").CurrentRegion.Resize(, 4)
    Set dic = CreateObject("scripting.dictionary")
    Set d = CreateObject("scripting.dictionary")
    Set d1 = CreateObject("scripting.dictionary")
    ReDim brr(1 To 6)
    For i = 2 To UBound(arr)
        If Not dic.exists(arr(i, 2)) Then
            For j = 2 To UBound(arr, 2) - 4
                brr(j - 1) = arr(i, j)
            Next
            d1(arr(i, 2)) = brr
            Set dic(arr(i, 2)) = CreateObject("scripting.dictionary")
        End If
        dic(arr(i, 2))(arr(i, 1)) = arr(i, 10)
    Next i
    For i = 2 To UBound(crr)
        d(crr(i, 1)) = crr(i, 4)
    Next i
    ReDim brr(1 To dic.Count, 1 To 8)
    For i = 0 To dic.Count - 1
        temp = dic.keys()(i)
        For Each k In dic(temp).keys
            sm = sm + d(k) * dic(temp)(k)
        Next k
        If sm > 0 Then
            n = n + 1
            brr(n, 8) = sm
            For Each ik In d1(temp)
                num = num + 1
                brr(n, num) = ik
            Next ik
            num = 0
            sm = 0
        End If
    Next i
    Sheet2.[a2:h10000].ClearContents
    Sheet2.[a2].Resize(UBound(brr), UBound(brr, 2)) = brr
    Set dic = Nothing
    Set d = Nothing
    Set d1 = Nothing
End Sub

蓝桥玄霜

表1中没有“产材料”名称的数据，所以不能确定就是产材料01，也可能是产材料02

anline1739

蓝桥玄霜 发表于 2022-12-13 10:36
表1中没有“产材料”名称的数据，所以不能确定就是产材料01，也可能是产材料02

蓝版主，sheet1里A列到D列才是统计的数据，后面的的都是举例说明计算过程的。计算过程如图所示。

于箱长

感觉好烧脑

ykcbf1100

你试一下吧。

fzxba

1. Sub test1()

复制代码

anline1739

ykcbf1100 发表于 2022-12-13 11:16
你试一下吧。

非常感谢，原表运算就是我要的结果。，但是，若在sheet1与sheet3增加明细，如新附件，运算的结果就不对，例如我增加了HL车间的材料明细，然后清除原本所有的本次计划数量，只有HL的本次计划数量，但是sheet2里还是会有原本TH、ZP运算材料，只是数量都为空值了。若我只想在sheet2里只有HL的结果，就是每次运算不留有上次运算结算，只留有本次计划数量有数值的结果，应该如何改呢？