[已解决]求大家帮忙解决这个问题

huweifvba

求大家帮帮忙了。

最佳答案

月排行榜 / 总排行榜

zjdh

2011-8-19 18:51

1. Sub SC1()
   
2.     Dim arr, arr1, d As Object, d1 As Object, d2 As Object, x&
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Set d1 = CreateObject("scripting.dictionary")
   
5.     Set d2 = CreateObject("scripting.dictionary")
   
6.     With Sheets("sheet1")
   
7.         arr = .Range("A2:B" & .[A65536].End(3).Row)
   
8.     End With
   
9.     With Sheets("bom")
   
10.         arr1 = .Range("A2:F" & .[A65536].End(3).Row)
    
11.     End With
    
12.     For x = 1 To UBound(arr)
    
13.         For y = 1 To UBound(arr1)
    
14.             If arr1(y, 1) = arr(x, 1) And arr1(y, 6) <> "自制品" Then
    
15.                 d(arr1(y, 2)) = d(arr1(y, 2)) + arr1(y, 5) * arr(x, 2)
    
16.                 d1(arr1(y, 2)) = arr1(y, 3)
    
17.                 d2(arr1(y, 2)) = arr1(y, 4)
    
18.             End If
    
19.         Next y
    
20.     Next x
    
21.     Sheets("sheet3").Select
    
22.     Range("A:D").Clear
    
23.     [a4].Resize(d.Count, 1) = Application.Transpose(d.keys)
    
24.     [b4].Resize(d.Count, 1) = Application.Transpose(d1.items)
    
25.     [c4].Resize(d.Count, 1) = Application.Transpose(d2.items)
    
26.     [d4].Resize(d.Count, 1) = Application.Transpose(d.items)
    
27.     [a3] = "物料编号"
    
28.     [b3] = "物料名称"
    
29.     [c3] = "单位"
    
30.     [d3] = "数量"
    
31.     [a3].Resize(d.Count + 1, 4).Borders.LineStyle = 1
    
32. End Sub

复制代码

跳转到最佳答案楼层

zjdh

1. Sub SC1()
   
2.     Dim arr, arr1, d As Object, d1 As Object, d2 As Object, x&
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Set d1 = CreateObject("scripting.dictionary")
   
5.     Set d2 = CreateObject("scripting.dictionary")
   
6.     With Sheets("sheet1")
   
7.         arr = .Range("A2:B" & .[A65536].End(3).Row)
   
8.     End With
   
9.     With Sheets("bom")
   
10.         arr1 = .Range("A2:F" & .[A65536].End(3).Row)
    
11.     End With
    
12.     For x = 1 To UBound(arr)
    
13.         For y = 1 To UBound(arr1)
    
14.             If arr1(y, 1) = arr(x, 1) And arr1(y, 6) <> "自制品" Then
    
15.                 d(arr1(y, 2)) = d(arr1(y, 2)) + arr1(y, 5) * arr(x, 2)
    
16.                 d1(arr1(y, 2)) = arr1(y, 3)
    
17.                 d2(arr1(y, 2)) = arr1(y, 4)
    
18.             End If
    
19.         Next y
    
20.     Next x
    
21.     Sheets("sheet3").Select
    
22.     Range("A:D").Clear
    
23.     [a4].Resize(d.Count, 1) = Application.Transpose(d.keys)
    
24.     [b4].Resize(d.Count, 1) = Application.Transpose(d1.items)
    
25.     [c4].Resize(d.Count, 1) = Application.Transpose(d2.items)
    
26.     [d4].Resize(d.Count, 1) = Application.Transpose(d.items)
    
27.     [a3] = "物料编号"
    
28.     [b3] = "物料名称"
    
29.     [c3] = "单位"
    
30.     [d3] = "数量"
    
31.     [a3].Resize(d.Count + 1, 4).Borders.LineStyle = 1
    
32. End Sub

复制代码