[已解决]用VBA方法完成成本核算

绝峰

大灰狼1976 发表于 2017-7-25 16:13
那超过说明书行数怎么处理。

说明书行数最多只要51行，也就是说每个产品型号及面料的材料种类最多只有30种。“人工工资”资料放在图片的右边。

绝峰

大灰狼1976 发表于 2017-7-25 16:04
奇怪我保存之后，D2单元格的数据有效性就没有了。
不过没关系，你先试试主要功能吧，或者自己加一下数据有 ...

数据有效性，我会设置了，谢谢！

大灰狼1976

2010版你能打开么？

绝峰

大灰狼1976 发表于 2017-7-25 16:59
2010版你能打开么？

现在基本上可以了，现在是以产品型号D2触发，能不能以面料G2触发，请老师再次帮忙，谢谢！

大灰狼1976

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. If Target.Count > 1 Then Exit Sub
   
3. If Target.Address <> [g2].Address Then Exit Sub
   
4. Union([a20:j49], [e4:j16]).ClearContents
   
5. If Target = "" Then Exit Sub
   
6. Dim rng As Range
   
7. Set rng = Sheets(3).Columns(1).Find(Target.Offset(, -3), lookat:=xlWhole)
   
8. If rng Is Nothing Then Exit Sub
   
9. Dim arr, brr(1 To 30, 1 To 10), crr(1 To 13, 1 To 6), i&, r&, r1&, s$, s1$, d4$
   
10. s = [d2]: s1 = Target: d4 = Range("d4").Value
    
11. arr = Sheets(2).Range("b3:m" & Sheets(2).[b65536].End(3).Row)
    
12. For i = 1 To UBound(arr)
    
13.   If arr(i, 1) = s And arr(i, 2) = s1 Then
    
14.     If arr(i, 4) <> d4 Then
    
15.       r = r + 1
    
16.       brr(r, 1) = r
    
17.       brr(r, 2) = arr(i, 4)
    
18.       brr(r, 3) = arr(i, 3)
    
19.       brr(r, 4) = arr(i, 6)
    
20.       brr(r, 5) = arr(i, 11)
    
21.       brr(r, 6) = arr(i, 7)
    
22.       brr(r, 7) = arr(i, 8)
    
23.       brr(r, 8) = arr(i, 9)
    
24.       brr(r, 9) = arr(i, 10)
    
25.       brr(r, 10) = arr(i, 12)
    
26.     Else
    
27.       r1 = r1 + 1
    
28.       crr(r1, 1) = arr(i, 5)
    
29.       crr(r1, 2) = arr(i, 9)
    
30.       crr(r1, 3) = arr(i, 8)
    
31.       crr(r1, 4) = arr(i, 9)
    
32.       crr(r1, 5) = arr(i, 10)
    
33.       crr(r1, 6) = arr(i, 12)
    
34.     End If
    
35.   End If
    
36. Next i
    
37. [a20].Resize(30, 10) = brr
    
38. [e4].Resize(13, 6) = crr
    
39. End Sub

复制代码

绝峰

大灰狼1976 发表于 2017-7-26 08:50

谢谢老师！非常感谢！