[已解决]怎样用VBA写这样的统计表

manz · 发表于 2014-10-14 11:28

怎样用VBA写这样的统计表，sheet1和sheet2是可刷新的数据，sheet3表用VBA代码做出统计，而不是用函数公式来统计。另外，sheet1表的数据能有1600多页，用WEB查询一页一页的提取数据是一项很巨大的任务量，能否也帮忙写出用VBA自动提取网页里的数据，提取到sheet1表里。现在附件sheet1表里的数据是我我已经提取了100多页的数据了。

最佳答案

月排行榜 / 总排行榜

grf1973

2014-10-15 11:38

可以。我把代码改了一下，sheet2不动，sheet3小改一下，把“涨幅”改为“涨幅↓”就可以了。
附件的代码可以直接移植到全数据表中。

跳转到最佳答案楼层

grf1973 · 发表于 2014-10-14 13:23

可能附件太大，我的权限上传不了，传个代码吧。

Sub tt()
xt = Timer
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
r = Sheet1.Cells(Sheet1.Rows.Count, 1).End(3).Row '根据Sheet1计算C列到L列
arr = Sheet1.Range("a1:h" & r)
For i = 2 To UBound(arr)
x = arr(i, 1) & arr(i, 7) '名称+买卖盘性质
d(x) = d(x) + 1
d1(x) = d1(x) + arr(i, 5)
Next
brr = [a1].CurrentRegion
ReDim bbrr(1 To UBound(brr) - 1, 1 To 10)
For i = 2 To UBound(brr)
x1 = brr(i, 2) & "买盘"
x2 = brr(i, 2) & "卖盘"
x3 = brr(i, 2) & "中性盘"
p = i - 1
bbrr(p, 1) = d1(x1): bbrr(p, 8) = d(x1) '买盘数/重复数
bbrr(p, 2) = d1(x2): bbrr(p, 9) = d(x2) '卖盘数/重复数
bbrr(p, 3) = d1(x3): bbrr(p, 10) = d(x3) '中性盘数/重复数
s = bbrr(p, 1) + bbrr(p, 2) + bbrr(p, 3): bbrr(p, 4) = s '总盘数
If s > 0 Then
bbrr(p, 5) = bbrr(p, 1) / s '买占比
bbrr(p, 6) = bbrr(p, 2) / s '卖占比
bbrr(p, 7) = bbrr(p, 3) / s '中占比
End If
Next
[C2].Resize(p, 10) = bbrr
d.RemoveAll '根据Sheet2计算M列到Z列
r = Sheet2.Cells(Sheet2.Rows.Count, 1).End(3).Row
arr = Sheet2.Range("a1:ad" & r)
For i = 3 To UBound(arr)
Debug.Print i
For j = 6 To UBound(arr, 2)
x = Val(arr(i, 2)) & UCase(arr(1, j))
d(x) = d(x) + Val(arr(i, j))
Next
Next
ReDim crr(1 To UBound(brr) - 1, 1 To UBound(brr, 2))
For i = 2 To UBound(brr)
For j = 13 To UBound(brr, 2)
p = i - 1: q = j - 12
x = Val(brr(i, 1)) & brr(1, j)
crr(p, q) = d(x)
Next
Next
[M2].Resize(p, q) = crr
MsgBox "耗时" & Timer - xt & "秒"
End Sub

复制代码

grf1973 · 发表于 2014-10-14 13:24

另外，由于sheet3和sheet2的表头不同，所以要把sheet2的表头参照sheet3的表头改一下。具体见你另一帖子的sheet2，那里的表头已经改好了。

manz · 发表于 2014-10-15 10:06

grf1973 发表于 2014-10-14 13:24
另外，由于sheet3和sheet2的表头不同，所以要把sheet2的表头参照sheet3的表头改一下。具体见你另一帖子的sh ...

grf1973老师：按照您的代码，怎么有没参与计算的列呢。我把大部分数据删除了，文件变小了，你看看能上传附件了吧！

grf1973 · 发表于 2014-10-15 10:17

注意sheet2的表头。。。。。。。。如果不改是不能正确汇总的。因为我是按sheet3的表头作汇总的，所以要把sheet2的表头改成可以和sheet3表头相对应。

manz · 发表于 2014-10-15 10:56

grf1973 发表于 2014-10-15 10:17
注意sheet2的表头。。。。。。。。如果不改是不能正确汇总的。因为我是按sheet3的表头作汇总的，所以要把sh ...

grf1973老师：我明白了，sheet2的表头必须跟sheet3的表头一致才可以！但是，sheet2表是可刷新的表，刷新之后，又变成原来的样子，我还要在重新修改sheet2的表头，您看这样行不行，我把sheet3的表头修改成和sheet2表头的样式一致，这样，我每次刷新完sheet2表后就不用在修改表头了。

grf1973 · 发表于 2014-10-15 11:38

这个最佳答案由 grf1973 给出，感谢 grf1973 的回答。

单击隐藏图章

可以。我把代码改了一下，sheet2不动，sheet3小改一下，把“涨幅”改为“涨幅↓”就可以了。
附件的代码可以直接移植到全数据表中。

manz · 发表于 2014-10-15 11:38

grf1973 发表于 2014-10-15 10:17
注意sheet2的表头。。。。。。。。如果不改是不能正确汇总的。因为我是按sheet3的表头作汇总的，所以要把sh ...

grf1973老师，我已经将sheet3表头修改成与sheet2表头一致，顺利成功通过，问题解决了！！！！！！！！！

grf1973 · 发表于 2014-10-15 11:42

我估计你改的会有问题的。因为原来代码是通过sheet2的第一行确定的，而第一行内容不唯一（比如有几个“大单”“中单”“小单”，汇总会出错的。7楼代码改过来了，把sheet2的第一行+第二行作为判断条件，就具备唯一性了。

manz · 发表于 2014-10-15 11:54

grf1973 发表于 2014-10-15 11:38
可以。我把代码改了一下，sheet2不动，sheet3小改一下，把“涨幅”改为“涨幅↓”就可以了。
附件的代码可 ...

grf1973老师：涨幅要修改，换手率。特大差。大单差。.....等的“率”和“差都要删除”我是不是很聪明呀!经过您的指导和帮助，成功解决了我的问题，计算速度好快，5万多行的数据，还不到2秒钟就计算完毕，要是函数公式的话，至少需要20多分钟，没想到VBA是如此的强大，可以说这个统计表在您的指导下是相当的完美和无暇，在这里，我要给您grf1973老师深深的鞠躬，谢谢您这几日里的指导和帮助，让您费心了，我也不知道是不是因为我耽误您很多的重要事情，如果是的话，在这里向您表示深深的歉意！谢谢您的帮助和指导，谢谢您。我的好grf1973老师！！！

		自动登录	找回密码
密码			注册

[已解决]怎样用VBA写这样的统计表

相关帖子