[已解决]已成功将文本导入到excel中，下一步就是如何调整表1

jessylake

把表1中成交数量为零的每笔交易去掉，根据表2中的明细数据，按照 “委托编号” 对表1每笔成交价格的平均值进行重新计算，小数不四舍五入，要求精确数，取代表1中的目前保留三位小数的平均价格
先导入到excel然后再根据表2调整表1.zip (31.92 KB, 下载次数: 16)

2015-3-27 18:50 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2015-3-28 13:23

1. Sub Macro2()
   
2. Dim arr, brr, crr, ar, d, i&, j%, s&, s2&, n&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Sheet1.Activate
   
5. arr = Range("a1").CurrentRegion
   
6. ReDim ar(1 To UBound(arr), 1 To UBound(arr, 2))
   
7. brr = Sheet2.Range("a1").CurrentRegion
   
8. ReDim crr(1 To UBound(brr), 1 To 2)
   
9. For i = 2 To UBound(brr)
   
10.     If Not d.exists(brr(i, 10)) Then
    
11.         s = s + 1
    
12.         d(brr(i, 10)) = s
    
13.         crr(s, 1) = brr(i, 8)
    
14.         crr(s, 2) = brr(i, 7)
    
15.     Else
    
16.         n = d(brr(i, 10))
    
17.         crr(n, 1) = crr(n, 1) + brr(i, 8)
    
18.         crr(n, 2) = crr(n, 2) + brr(i, 7)
    
19.     End If
    
20. Next
    
21. For i = 2 To UBound(arr)
    
22.     If arr(i, 9) <> 0 Then
    
23.         s2 = s2 + 1
    
24.         For j = 1 To UBound(arr, 2)
    
25.             ar(s2, j) = arr(i, j)
    
26.         Next
    
27.         If d.exists(ar(s2, 14)) Then
    
28.             n = d(ar(s2, 14))
    
29.             ar(s2, 8) = crr(n, 1) / crr(n, 2)
    
30.         End If
    
31.     End If
    
32. Next
    
33. [a2:n65536] = ""
    
34. Range("a2").Resize(s2, UBound(ar, 2)) = ar
    
35. End Sub

复制代码

跳转到最佳答案楼层

jessylake

调整应该要用到数组或字典，希望字典或数组高手出手相帮

dsmch

举例说明这句话：按照 “委托编号” 对表1每笔成交价格的平均值进行重新计算，小数不四舍五入，要求精确数，取代表1中的目前保留三位小数的平均价格

jessylake

dsmch 发表于 2015-3-28 11:01
举例说明这句话：按照 “委托编号” 对表1每笔成交价格的平均值进行重新计算，小数不四舍五入，要求精确数， ...

比如：
数据文件1中委托编号：702，成交数量：105100，成交价格（平均）：20.998（这是一个保留三位小数的平均价格，需要根据数据文件2中的明细进行重算，不四舍五入）

在数据文件2中找到委托编号：702，这就是上面这笔委托的成交明细，用这组数据算出精确的平均价格，不四舍五入

jessylake

dsmch 发表于 2015-3-28 11:01
举例说明这句话：按照 “委托编号” 对表1每笔成交价格的平均值进行重新计算，小数不四舍五入，要求精确数， ...

老师您好，网上有高手用sql语句做了一个，不知道这个用字典能不能完成

dsmch

1. Sub Macro2()
   
2. Dim arr, brr, crr, ar, d, i&, j%, s&, s2&, n&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Sheet1.Activate
   
5. arr = Range("a1").CurrentRegion
   
6. ReDim ar(1 To UBound(arr), 1 To UBound(arr, 2))
   
7. brr = Sheet2.Range("a1").CurrentRegion
   
8. ReDim crr(1 To UBound(brr), 1 To 2)
   
9. For i = 2 To UBound(brr)
   
10.     If Not d.exists(brr(i, 10)) Then
    
11.         s = s + 1
    
12.         d(brr(i, 10)) = s
    
13.         crr(s, 1) = brr(i, 8)
    
14.         crr(s, 2) = brr(i, 7)
    
15.     Else
    
16.         n = d(brr(i, 10))
    
17.         crr(n, 1) = crr(n, 1) + brr(i, 8)
    
18.         crr(n, 2) = crr(n, 2) + brr(i, 7)
    
19.     End If
    
20. Next
    
21. For i = 2 To UBound(arr)
    
22.     If arr(i, 9) <> 0 Then
    
23.         s2 = s2 + 1
    
24.         For j = 1 To UBound(arr, 2)
    
25.             ar(s2, j) = arr(i, j)
    
26.         Next
    
27.         If d.exists(ar(s2, 14)) Then
    
28.             n = d(ar(s2, 14))
    
29.             ar(s2, 8) = crr(n, 1) / crr(n, 2)
    
30.         End If
    
31.     End If
    
32. Next
    
33. [a2:n65536] = ""
    
34. Range("a2").Resize(s2, UBound(ar, 2)) = ar
    
35. End Sub

复制代码

jessylake

dsmch 发表于 2015-3-28 13:23

多谢老师的字典法，另外数据文件1在导入时因为最后一列数据是空的，导致最后一列台头“废单原因”跑到委托编号里面了，不知道导入时能不能避免出这种问题？详见新求助帖：
文本文件数据文件1最后一列“废单原因”（因为里面没有数据） 好像导入时有问题
http://www.excelpx.com/thread-340668-1-1.html

jessylake

dsmch 发表于 2015-3-28 13:23

老师这一步其实是下面问题的最核心的部分，剩下的就是数据提取了，您有空再帮我把导入和数据调整做一下最后整合（其实数据导入和调整只是临时数据，最终的目标是提取出来放到相应的位置），下面这个最终的问题就彻底解决了，再一次向您表达谢意！
期望高手解决一个从外部文件中将数据整合到excel表中，然后分类计算提取
http://www.excelpx.com/thread-340605-1-1.html