[已解决]如何将表1的表头下的数据自动添加到表2的最后一行

benwalla9

我将例子和要求的条件都写在附件了。各位看看。能不能有解决的方法

最佳答案

月排行榜 / 总排行榜

dsmch

2014-3-23 06:37

………………

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. On Error Resume Next
   
3. Dim arr, brr, crr(1 To 60000, 1 To 3), d
   
4. Set d = CreateObject("scripting.dictionary")
   
5. arr = Range("a1").CurrentRegion
   
6. brr = Sheets("货号位置").Range("a1").CurrentRegion
   
7. For i = 2 To UBound(brr)
   
8.     If Not d.exists(brr(i, 1)) Then
   
9.         s = s + 1
   
10.         d(brr(i, 1)) = s
    
11.         crr(s, 1) = brr(i, 1)
    
12.         crr(s, 2) = brr(i, 2)
    
13.         crr(s, 3) = brr(i, 3)
    
14.     Else
    
15.         crr(d(brr(i, 1)), 2) = crr(d(brr(i, 1)), 2) + brr(i, 2)
    
16.     End If
    
17. Next
    
18. For i = 2 To UBound(arr)
    
19.     If Not d.exists(arr(i, 1)) Then
    
20.         s = s + 1
    
21.         d(arr(i, 1)) = s
    
22.         crr(s, 1) = arr(i, 1)
    
23.         crr(s, 2) = arr(i, 2)
    
24.         crr(s, 3) = arr(i, 3)
    
25.     Else
    
26.         crr(d(arr(i, 1)), 2) = crr(d(arr(i, 1)), 2) + arr(i, 2)
    
27.     End If
    
28. Next
    
29. Sheets("货号位置").Range("a2").Resize(s, 3) = crr
    
30. Range("a1").CurrentRegion.Offset(1, 0).ClearContents
    
31. End Sub
    

复制代码

dsmch

………………

风林火山

1. Sub 入库处理()
   
2.     Dim arr, brr, k%, irow%, str$, d
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Sheets("入库").Range("a1").CurrentRegion
   
5.     brr = Sheets("货号位置").Range("a1").CurrentRegion
   
6.     Application.ScreenUpdating = False
   
7.     On Error Resume Next
   
8.     '货号位置字典
   
9.     For k = 2 To UBound(brr)
   
10.         str = brr(k, 1) & brr(k, 3)
    
11.         If Not d.exists(str) Then d(str) = k
    
12.     Next
    
13.     '汇总数据
    
14.     For k = 2 To UBound(arr)
    
15.         str = arr(k, 1) & arr(k, 3)
    
16.         If Not d.exists(str) Then
    
17.             d(str) = d.Count + 2
    
18.             irow = d(str)
    
19.             With Worksheets("货号位置")
    
20.                 .Cells(irow, 1) = arr(k, 1)
    
21.                 .Cells(irow, 2) = arr(k, 2)
    
22.                 .Cells(irow, 3) = arr(k, 3)
    
23.             End With
    
24.         Else
    
25.             irow = d(str)
    
26.             Worksheets("货号位置").Cells(irow, 2) = Worksheets("货号位置").Cells(irow, 2) + arr(k, 2)
    
27. 
    
28.         End If
    
29.     Next
    
30.     Sheets("入库").Range("a2:c65536").ClearContents
    
31.     Application.ScreenUpdating = True
    
32. End Sub

复制代码

benwalla9

今天星期天在家哄儿子，兼接待娘家人没有上网。很抱歉没有及时回复。我看看先。谢谢

benwalla9

234都可以呢。谢谢教习

benwalla9

VBA学习对英语要求高吗？

benwalla9

VBA学习对英语要求高吗？本人经常录制方式建宏，而使用代码老是错误调试。
既然入库能够实现功能，那么请问反向出库时，点击出库，怎么在货品位置表自动减去出库的记录。并且要求如果货品位置表某个条形吗的数量因减去而数量为零的时候。自动删除该条形吗所在的行。