[已解决]如何提取2016的数据，谢谢huang1314wei老师！

lhj323323

老师

我想利用字典实现提取2016年的不重复数据，但没有成功，请帮我看看，我错在哪里了，谢谢了
上传的附件中，有写好的语句。
提取2016.rar (37.76 KB, 下载次数: 7)

2016-5-18 07:33 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

huang1314wei

2016-5-18 22:26

lhj323323 发表于 2016-5-18 22:00
谢谢老师

就是按股票代码提取不重复值，这些数据的时间归属是2016年的。

仔细看了一下，原来在加入字典的时候，前期的原值没有赋值给数组，所以导致有的数据没有汇总，在上面的代码添加三行代码即可

1. Sub 交割()
   
2.     Dim Myr%, x, k
   
3.     Dim arr, ayy()
   
4. Application.ScreenUpdating = False
   
5. 
   
6.     Set d = CreateObject("scripting.dictionary")
   
7.     With Sheet14
   
8.          Myr = .Range("C65536").End(xlUp).Row
   
9.          arr = .Range("A2:L" & Myr)
   
10.     End With
    
11.     ReDim ayy(1 To UBound(arr), 0 To 5)
    
12.         
    
13.     For x = 1 To UBound(arr)
    
14.       If arr(x, 1) = 2016 Then
    
15.         If Not d.exists(arr(x, 3) * 1) Then '提取不重复股票代码
    
16.            k = k + 1
    
17.            ayy(k, 0) = arr(x, 3)            '股票代码
    
18.            ayy(k, 1) = arr(x, 4)            '股票名称
    
19.            ayy(k, 2) = arr(x, 7)
    
20.            ayy(k, 3) = arr(x, 12)
    
21.            ayy(k, 4) = 1
    
22.            d.Add arr(x, 3) * 1, k            '将股票代码纳入字典管理
    
23.         Else
    
24.            ayy(d(arr(x, 3) * 1), 2) = ayy(d(arr(x, 3) * 1), 2) + arr(x, 7)     '股数
    
25.            ayy(d(arr(x, 3) * 1), 3) = ayy(d(arr(x, 3) * 1), 3) + arr(x, 12)    '发生金额，含税费
    
26.            ayy(d(arr(x, 3) * 1), 4) = ayy(d(arr(x, 3) * 1), 4) + 1             '交易次数
    
27.         End If
    
28.      End If
    
29.         
    
30.     Next x
    
31.    
    
32.     With Sheet15 '结果表
    
33.         .[s:w].Clear 'Contents
    
34.         .Columns("s:s").NumberFormatLocal = "000000"
    
35.         .Range("s2").Resize(k, UBound(ayy, 2)) = ayy
    
36.     End With
    
37. 
    
38.     Myr = 0
    
39.     Erase arr: Erase ayy
    
40.     x = 0: k = 0
    
41.     d.RemoveAll
    
42. Application.ScreenUpdating = True
    
43. End Sub

复制代码

跳转到最佳答案楼层

huang1314wei

没有细看，看一下是不是这个意思

Sub 交割()
    Dim Myr%, x, k
    Dim arr, ayy()
Application.ScreenUpdating = False

'一、。
    Set d = CreateObject("scripting.dictionary")
    With Sheet14
         Myr = .Range("C65536").End(xlUp).Row
         arr = .Range("A2:L" & Myr)
    End With
    ReDim ayy(1 To UBound(arr), 0 To 5)
        
    For x = 1 To UBound(arr)
      If arr(x, 1) = "2016" Then
        If Not d.exists(arr(x, 3) * 1) Then '提取不重复股票代码
           k = k + 1
           ayy(k, 0) = arr(x, 3)            '股票代码
           ayy(k, 1) = arr(x, 4)            '股票名称
           d.Add arr(x, 3) * 1, k           '将股票代码纳入字典管理
        Else
      
        
        ayy(d(arr(x, 3) * 1), 2) = ayy(d(arr(x, 3) * 1), 2) + arr(x, 7)     '股数
        ayy(d(arr(x, 3) * 1), 3) = ayy(d(arr(x, 3) * 1), 3) + arr(x, 12)    '发生金额，含税费
        ayy(d(arr(x, 3) * 1), 4) = ayy(d(arr(x, 3) * 1), 4) + 1             '交易次数
        End If
       End If
    Next x
   
    With Sheet15 '结果表
        .[s:w].Clear 'Contents
        .Columns("s:s").NumberFormatLocal = "000000"
        .Range("s2").Resize(k, UBound(ayy, 2)) = ayy
    End With

    Myr = 0
    Erase arr: Erase ayy
    x = 0: k = 0
    d.RemoveAll
Application.ScreenUpdating = True
End Sub

lhj323323

huang1314wei 发表于 2016-5-18 07:59
没有细看，看一下是不是这个意思

Sub 交割()

谢谢老师的回复

但是，与正确的答案有出入，明细如下：

huang1314wei

lhj323323 发表于 2016-5-18 21:18
谢谢老师的回复

但是，与正确的答案有出入，明细如下：

你把你的要求说一下，重新设计代码比较好

lhj323323

huang1314wei 发表于 2016-5-18 21:21
你把你的要求说一下，重新设计代码比较好

谢谢老师

就是按股票代码提取不重复值，这些数据的时间归属是2016年的。

huang1314wei

lhj323323 发表于 2016-5-18 22:00
谢谢老师

就是按股票代码提取不重复值，这些数据的时间归属是2016年的。

仔细看了一下，原来在加入字典的时候，前期的原值没有赋值给数组，所以导致有的数据没有汇总，在上面的代码添加三行代码即可

1. Sub 交割()
   
2.     Dim Myr%, x, k
   
3.     Dim arr, ayy()
   
4. Application.ScreenUpdating = False
   
5. 
   
6.     Set d = CreateObject("scripting.dictionary")
   
7.     With Sheet14
   
8.          Myr = .Range("C65536").End(xlUp).Row
   
9.          arr = .Range("A2:L" & Myr)
   
10.     End With
    
11.     ReDim ayy(1 To UBound(arr), 0 To 5)
    
12.         
    
13.     For x = 1 To UBound(arr)
    
14.       If arr(x, 1) = 2016 Then
    
15.         If Not d.exists(arr(x, 3) * 1) Then '提取不重复股票代码
    
16.            k = k + 1
    
17.            ayy(k, 0) = arr(x, 3)            '股票代码
    
18.            ayy(k, 1) = arr(x, 4)            '股票名称
    
19.            ayy(k, 2) = arr(x, 7)
    
20.            ayy(k, 3) = arr(x, 12)
    
21.            ayy(k, 4) = 1
    
22.            d.Add arr(x, 3) * 1, k            '将股票代码纳入字典管理
    
23.         Else
    
24.            ayy(d(arr(x, 3) * 1), 2) = ayy(d(arr(x, 3) * 1), 2) + arr(x, 7)     '股数
    
25.            ayy(d(arr(x, 3) * 1), 3) = ayy(d(arr(x, 3) * 1), 3) + arr(x, 12)    '发生金额，含税费
    
26.            ayy(d(arr(x, 3) * 1), 4) = ayy(d(arr(x, 3) * 1), 4) + 1             '交易次数
    
27.         End If
    
28.      End If
    
29.         
    
30.     Next x
    
31.    
    
32.     With Sheet15 '结果表
    
33.         .[s:w].Clear 'Contents
    
34.         .Columns("s:s").NumberFormatLocal = "000000"
    
35.         .Range("s2").Resize(k, UBound(ayy, 2)) = ayy
    
36.     End With
    
37. 
    
38.     Myr = 0
    
39.     Erase arr: Erase ayy
    
40.     x = 0: k = 0
    
41.     d.RemoveAll
    
42. Application.ScreenUpdating = True
    
43. End Sub

复制代码

lhj323323

huang1314wei 发表于 2016-5-18 22:26
仔细看了一下，原来在加入字典的时候，前期的原值没有赋值给数组，所以导致有的数据没有汇总，在上面的代 ...

测试对了，非常感谢huang1314wei老师!