[已解决]再次修改后的目标取数

jennis2009

老师们，附件中的目标成本表已修改，请帮忙看看是否可以把“目标成本”表里不同纸种和项目对应的目标成本引用到“车间成本”表里对应的纸种和项目（辅料和车间费用）内，其中“目标成本”表中的“保洁剂+清洁剂+杀菌剂+烧齡+除垢劑”=车间成本表里的“保洁剂”，另外，请不要把“目标成本”表中的蓝色标识的部分引用到“车间成本”表中，谢谢！ 目标成本取数已修改.zip (45.8 KB, 下载次数: 9)

2014-9-17 18:31 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

grf1973

2014-9-19 11:42

刚才代码没考虑保洁剂的要求，用现代码。。。。。。

1. Sub tt()
   
2.     arr = Sheet2.Range("a1:ap34")
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     xstr = "保潔劑殺菌劑清洗劑除垢劑鹹類"
   
5.     For i = 4 To UBound(arr)
   
6.         xm = arr(i, 1)   '项目
   
7.         If InStr(xstr, xm) > 0 Then xm = "保潔劑"
   
8.         For j = 6 To UBound(arr, 2) Step 3
   
9.             zl = arr(1, j - 2)      '纸类
   
10.             d(xm & zl) = d(xm & zl) + arr(i, j)         '项目+纸类为key，目标成本为item
    
11.         Next
    
12.     Next
    
13.     arr = Sheet1.Range("a1:ex41")
    
14.     For i = 12 To UBound(arr)
    
15.         xm = arr(i, 2)
    
16.         If InStr(xm, "成本") = 0 Then   '不含成本行
    
17.             For j = 81 To UBound(arr, 2) Step 4
    
18.                 zl = arr(4, j - 2)      '纸类
    
19.                 arr(i, j) = d(xm & zl)
    
20.             Next
    
21.         End If
    
22.     Next
    
23.     Sheet1.Range("a1:ex41") = arr
    
24. End Sub
    
25. 
    

复制代码

跳转到最佳答案楼层

grf1973

1. Sub tt()
   
2.     arr = Sheet2.Range("a1:ap34")
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For i = 4 To UBound(arr)
   
5.         xm = arr(i, 1)   '项目
   
6.         For j = 6 To UBound(arr, 2) Step 3
   
7.             zl = arr(1, j - 2)      '纸类
   
8.             d(xm & zl) = arr(i, j)           '项目+纸类为key，目标成本为item
   
9.         Next
   
10.     Next
    
11.     arr = Sheet1.Range("a1:ex41")
    
12.     For i = 12 To UBound(arr)
    
13.         xm = arr(i, 2)
    
14.         If InStr(xm, "成本") = 0 Then   '不含成本行
    
15.             For j = 81 To UBound(arr, 2) Step 4
    
16.                 zl = arr(4, j - 2)      '纸类
    
17.                 arr(i, j) = d(xm & zl)
    
18.             Next
    
19.         End If
    
20.     Next
    
21.     Sheet1.Range("a1:ex41") = arr
    
22. End Sub
    

复制代码

grf1973

请看附件。

grf1973

刚才代码没考虑保洁剂的要求，用现代码。。。。。。

1. Sub tt()
   
2.     arr = Sheet2.Range("a1:ap34")
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     xstr = "保潔劑殺菌劑清洗劑除垢劑鹹類"
   
5.     For i = 4 To UBound(arr)
   
6.         xm = arr(i, 1)   '项目
   
7.         If InStr(xstr, xm) > 0 Then xm = "保潔劑"
   
8.         For j = 6 To UBound(arr, 2) Step 3
   
9.             zl = arr(1, j - 2)      '纸类
   
10.             d(xm & zl) = d(xm & zl) + arr(i, j)         '项目+纸类为key，目标成本为item
    
11.         Next
    
12.     Next
    
13.     arr = Sheet1.Range("a1:ex41")
    
14.     For i = 12 To UBound(arr)
    
15.         xm = arr(i, 2)
    
16.         If InStr(xm, "成本") = 0 Then   '不含成本行
    
17.             For j = 81 To UBound(arr, 2) Step 4
    
18.                 zl = arr(4, j - 2)      '纸类
    
19.                 arr(i, j) = d(xm & zl)
    
20.             Next
    
21.         End If
    
22.     Next
    
23.     Sheet1.Range("a1:ex41") = arr
    
24. End Sub
    
25. 
    

复制代码

jennis2009

谢谢老师们的热心解答，问题已解决！