[已解决]求助VBA！！！

新一

如何用VBA，自动生成单价。
http://www.excelpx.com/thread-321948-1-1.html

最佳答案

月排行榜 / 总排行榜

dsmch

2014-3-31 20:46

表一、表二输入工序后自动产生结果，表三建议用子程序解决

跳转到最佳答案楼层

dsmch

1. Private Sub Workbook_Open()
   
2. Call aaa
   
3. End Sub
   
4. 
   
5. Public ar, dd
   
6. Sub aaa()
   
7. Dim i&
   
8. Set dd = CreateObject("scripting.dictionary")
   
9. ar = Sheets("单价").Range("a1").CurrentRegion
   
10. For i = 2 To UBound(ar)
    
11.     If ar(i, 2) = "" Then ar(i, 1) = ar(i - 1, 2)
    
12.     zf = ar(i, 2) & "," & ar(i, 3)
    
13.     dd(zf) = ar(i, 4)
    
14. Next
    
15. End Sub
    
16. 
    
17. Sub Worksheet_Change(ByVal Target As Range)
    
18. If Target.Column = 2 Then
    
19.     x = Range([a2], Target).Find("名称：*", SearchDirection:=xlPrevious).Row
    
20.     zf = Trim(Mid(Cells(x, 1), 4)) & "," & Target.Value
    
21.     Target.Offset(0, 3).Value = dd(zf)
    
22. End If
    
23. End Sub
    

复制代码

dsmch

表一、表二输入工序后自动产生结果，表三建议用子程序解决

新一

dsmch 发表于 2014-3-31 20:46
表一、表二输入工序后自动产生结果，表三建议用子程序解决

可否帮我把表三的问题解决，谢谢

dsmch

1. Sub Macro2()
   
2. Dim arr, brr, i&, zf$
   
3. arr = Range("a1").CurrentRegion
   
4. ReDim brr(1 To UBound(arr) - 2, 1 To 1)
   
5. For i = 3 To UBound(arr)
   
6.     zf = arr(i, 3) & "," & arr(i, 4)
   
7.     brr(i - 2, 1) = dd(zf)
   
8. Next
   
9. Range("e3").Resize(UBound(brr)) = brr
   
10. End Sub
    

复制代码

dsmch

………………

新一

dsmch 发表于 2014-3-31 21:06
………………

非常感谢

新一

dsmch 发表于 2014-3-31 21:06
………………

为何复制和删除，都会出现提示？

新一

dsmch 发表于 2014-3-31 21:06
………………

在单价表中，在某一个产品增加两个工序，但表二和表三都不能显视？

dsmch

新一 发表于 2014-3-31 21:18
为何复制和删除，都会出现提示？

代码按一次改变一个单元格设计的。
保存后打开工作簿才能触发代码