[已解决]求高手修改VBA代码

rongkaizhou

求高手修改VBA代码     附附件

最佳答案

月排行榜 / 总排行榜

grf1973

2014-12-15 11:20

采用原附件固定表式（8--100，108--200行两张表），B列客户没自动生成。如果需要的话也可以根据“出货数据”表自动生成，这样表格大小就可以根据客户数自动调节了。

跳转到最佳答案楼层

猛哥

但愿，有所突破。

rongkaizhou

猛哥 发表于 2014-12-13 01:07
但愿，有所突破。

老师们帮帮忙吧

grf1973

1. Sub tt()
   
2. Dim arr, i&, j&, sht2 As Worksheet
   
3.     arr = Worksheets("出货数据").[a1].CurrentRegion  '将出货数据读入数组，其中3列为客户名称，5列为产品名称，9列为产品数量，11列为金额，18列为日期
   
4.     d1 = Cells(4, 7): d2 = Cells(4, 10)
   
5.     Set d = CreateObject("scripting.dictionary")   '出货
   
6.     Set dd = CreateObject("scripting.dictionary")   '退货
   
7.    
   
8.     For i = 2 To UBound(arr)        '读入数据，客户名+品项为key，数量为item
   
9.         If arr(i, 18) >= d1 And arr(i, 18) <= d2 And arr(i, 11) <> 0 Then       '日期符合条件，总金额不为0
   
10.             xkey = arr(i, 3) & arr(i, 5): xcount = arr(i, 9)
    
11.             If xcount > 0 Then   '数量大于0，出货
    
12.                 d(xkey) = d(xkey) + xcount
    
13.             ElseIf xcount < 0 Then    '数量小于0，退货
    
14.                 dd(xkey) = dd(xkey) + Abs(xcount)
    
15.             End If
    
16.         End If
    
17.     Next
    
18.    
    
19.     [c8:cp100].ClearContents       '出货表
    
20.     arr = [b7:cp100]
    
21.     For i = 2 To UBound(arr)
    
22.         If arr(i, 1) <> "" Then
    
23.             For j = 2 To UBound(arr, 2)
    
24.                 If arr(1, j) <> "" Then
    
25.                     xkey = arr(i, 1) & arr(1, j)
    
26.                     arr(i, j) = d(xkey)
    
27.                 End If
    
28.             Next
    
29.         End If
    
30.     Next
    
31.     [b7:cp100] = arr
    
32.    
    
33.     [c108:cp200].ClearContents    '退货表
    
34.     arr = [b107:cp200]
    
35.     For i = 2 To UBound(arr)
    
36.         If arr(i, 1) <> "" Then
    
37.             For j = 2 To UBound(arr, 2)
    
38.                 If arr(1, j) <> "" Then
    
39.                     xkey = arr(i, 1) & arr(1, j)
    
40.                     arr(i, j) = dd(xkey)
    
41.                 End If
    
42.             Next
    
43.         End If
    
44.     Next
    
45.     [b107:cp200] = arr
    
46.    
    
47. End Sub

复制代码

grf1973

采用原附件固定表式（8--100，108--200行两张表），B列客户没自动生成。如果需要的话也可以根据“出货数据”表自动生成，这样表格大小就可以根据客户数自动调节了。

rongkaizhou

grf1973 发表于 2014-12-15 11:20
采用原附件固定表式（8--100，108--200行两张表），B列客户没自动生成。如果需要的话也可以根据“出货数据” ...

非常感谢grf1973老师的热心帮忙！你写得太完美了！退货表因为需要以负数体现数值，我只是把dd(xkey) = dd(xkey) + ABS(xcount)改为dd(xkey) = dd(xkey) + xcount就是我需要的结果，论坛有了你们这些高手在精彩纷呈啊！