【紧急求助！！！】VBA实现复杂的分类汇总统计方法

w_cun · 发表于 2015-10-21 20:52

附件表格里的代码是从东方财经抓取的数据过程，是从论坛里面找来的，我想对表格中抓取的数据进行二次处理，希望楼里面的同学能帮忙实现下，谢谢了！！！
使用VBA将左侧红色框内的股票数据分类汇总到右侧区域；
分类方法：取A列单元格左边三位数字，分别为000，001,002,300,600,601,603,200,900，分成六类：1_上证 =（600,601,603开头的，2_深圳（000,001,002，）， 3_创业板（300开头的）， 4_中小板（002开头的）， 5_601系（601开头的）， 6_B股（200,900开头的）

getdata.zip (292.69 KB, 下载次数: 30)

算法：

1、类型：从表格A列中获取，取A列单元格左边三位数字，分别为000，001,002,300,600,601,603,200,900，分成六类：1_上证 =（600,601,603开头的，2_深圳（000,001,002，）， 3_创业板（300开头的）， 4_中小板（002开头的）， 5_601系（601开头的）， 6_B股（200,900开头的）

2、总股数：按照M列6种“类型”分别计算相应类型的数量；例如：1_上证=countif（A：A，“600,601,603开头”）；

3、停盘数：按照M列6种“类型”分别计算D列相应类型停牌的数量；例如：1_上证=countif（D：D，“停牌”）；停牌信息在D列；

4、停盘%：=停盘数/总股数；

5、涨停数：按照M列6种“类型”分别计算F列相应类型的数量；例如：1_上证=countif（F：F，“>=9.9%”）；涨跌幅信息在F列；

6、跌停数：按照M列6种“类型”分别计算F列相应类型的数量；例如：1_上证=countif（F：F，“<=-9.9%”）；涨跌幅信息在F列；

7、红盘数：按照M列6种“类型”分别计算F列相应类型的数量；例如：1_上证=countif（F：F，“>0%”）；涨跌幅信息在F列；

8、平盘数：按照M列6种“类型”分别计算F列相应类型的数量；例如：1_上证=countif（F：F，“=0%”）；涨跌幅信息在F列；

9、绿盘数：按照M列6种“类型”分别计算F列相应类型的数量；例如：1_上证=countif（F：F，“< 0%”）；涨跌幅信息在F列；

10、红盘比：按照M列6种“类型”分别计算F列相应类型的数量；例如：1_上证=R列（红盘数）/N列（总股数）；

11、平均PE：按照M列6种“类型”分别计算H列相应类型的数量；例如：1_上证=average（H：H）group by 类型；平均PE信息在H列；

12、换手率>25：按照M列6种“类型”分别计算G列相应类型的数量；例如：1_上证=average（H：H）group by 类型；换手率>25信息在G列；

13、机构参与度>45：按照M列6种“类型”分别计算J列相应类型的数量；例如：1_上证=average（H：H）group by 类型；机构参与度>45信息在J列；

w_cun · 发表于 2015-11-2 08:56

找了两个类似的案例，附件及代码如下，是用数组字典做的，好厉害，继续学习做做看。
出处http://club.excelhome.net/thread-999194-1-1.html

分组组别倒数名次统计.rar (44.68 KB, 下载次数: 35)

保险汇总台账.rar (16.92 KB, 下载次数: 35)
Option Explicit
Sub Sum()
Dim dic As Object, arr, result(), i&, j&, m&, s&
Set dic = CreateObject("scripting.dictionary") '定义字典
arr = Sheet1.[a1].CurrentRegion.Value             '将工作表数据装入数组ＡＲＲ
ReDim result(1 To UBound(arr), 1 To UBound(arr, 2) - 2) '重新声明结果动态数组result的大小
result(1, 1) = arr(1, 4): result(1, 2) = "月数"       '以下将标题写入输出数组result
For j = 5 To UBound(arr, 2)
      result(1, j - 2) = arr(1, j)
Next
m = 1
For i = 2 To UBound(arr)    '在数组ＡRR中循环
      s = dic(Trim(arr(i, 4)))
      If s = Empty Then
         m = m + 1
         dic(Trim(arr(i, 4))) = m    '将姓名作为关键字装入字典dic,累计姓名数量作为对应项
         s = m                         '替换
         result(s, 1) = Trim(arr(i, 4))    '输出数组的第一列为姓名
      End If
      result(s, 2) = result(s, 2) + 1    '输出数组的第二列月份累计数
      For j = 5 To UBound(arr, 2)
         If Len(arr(i, j)) Then result(s, j - 2) = result(s, j - 2) + arr(i, j)       '输出数组的其余列为累加
      Next
Next
If m > 1 Then  '如果存在关键字
      With Sheet3 '结果写入ＳＨＥＥＴ3
         .UsedRange.ClearContents    '清空工作表数据
         With .[a1].Resize(m, UBound(result, 2))
            .Value = result          '将数据写入工作表Ａ1开始的区域
            .Font.Size = 10          '字号设定为10磅
            .Borders.LineStyle = 1    '加入边框
            .Columns.AutoFit          '自定调整列宽
         End With
      End With
End If
Set dic = Nothing    '释放字典
End Sub

treefive · 发表于 2015-11-28 08:14

楼主提供了很好思路，顶起来，大家一起帮忙解决。支持

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