[已解决]求助把已知数据统计遗漏，并标注上次遗漏值

瀚海人

我想做个数据遗漏的统计，包含当前行遗漏统计和上次遗漏统计

用函数公式和VBA都可，求助老师帮助
在线等

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2013-12-2 13:11

第1种：

1. Sub aaa()
   
2. Dim arr, i&, d As Object
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("b2:b" & [b65536].End(3).Row)
   
5. ReDim Preserve arr(1 To UBound(arr), 1 To 2)
   
6. For i = 1 To UBound(arr)
   
7.   If d.exists(arr(i, 1)) Then arr(i, 2) = i - d(arr(i, 1)) - 1 Else arr(i, 2) = i - 1
   
8.   d(arr(i, 1)) = i
   
9. Next i
   
10. [c2].Resize(UBound(arr)) = Application.Index(arr, , 2)
    
11. End Sub

复制代码

第2种：不理解，最好举例说明

跳转到最佳答案楼层

大灰狼1976

第1种：

1. Sub aaa()
   
2. Dim arr, i&, d As Object
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("b2:b" & [b65536].End(3).Row)
   
5. ReDim Preserve arr(1 To UBound(arr), 1 To 2)
   
6. For i = 1 To UBound(arr)
   
7.   If d.exists(arr(i, 1)) Then arr(i, 2) = i - d(arr(i, 1)) - 1 Else arr(i, 2) = i - 1
   
8.   d(arr(i, 1)) = i
   
9. Next i
   
10. [c2].Resize(UBound(arr)) = Application.Index(arr, , 2)
    
11. End Sub

复制代码

第2种：不理解，最好举例说明

瀚海人

上次遗漏值：是指奖号在上次出现的时候的当期遗漏数值
例如有一个奖号：999

这个数字在第1000期的时候出现了一次，当期的遗漏是500

                 而后在1200期的时候，第二次出现，那么当期的遗漏应该是200，上次的遗漏值，就是在第1000期出现的时候那个当期遗漏数值，就是500
谢谢灰太狼大哥，能否加个按钮来来运行vba

瀚海人

灰太狼大哥
这个vba可以在2007中运行吗
为什么我在2007中运行，仅仅计算了两行的数据呢

大灰狼1976

2007版没有问题的，如果行数不超65536的话，代码可以直接用，如果超过的话，简单修改下就能使用
第2个要求正在看

大灰狼1976

附件请测试

1. Private Sub CommandButton1_Click()
   
2. Dim arr, i&, d As Object, d1 As Object
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Set d1 = CreateObject("scripting.dictionary")
   
5. arr = Range("b2:b" & [b65536].End(3).Row)
   
6. ReDim Preserve arr(1 To UBound(arr), 1 To 3)
   
7. For i = 1 To UBound(arr)
   
8.   If d.exists(arr(i, 1)) Then arr(i, 2) = i - d(arr(i, 1)) - 1 Else arr(i, 2) = i - 1
   
9.   d(arr(i, 1)) = i
   
10.   If d1.exists(arr(i, 1)) Then arr(i, 3) = d1(arr(i, 1)) Else arr(i, 3) = ""
    
11.   d1(arr(i, 1)) = arr(i, 2)
    
12. Next i
    
13. [b2].Resize(UBound(arr), 3) = arr
    
14. End Sub

复制代码

瀚海人

Sub aaa()
    Dim A, B, i&, d As Object

    Set d = CreateObject("scripting.dictionary")
    A = Range("b2:b" & Cells(Rows.Count, "b").End(3).Row)
    ReDim B(1 To UBound(A), 1 To 1)

    For i = 1 To UBound(A)
        If d.exists(A(i, 1)) Then B(i, 1) = i - d(A(i, 1)) - 1 Else B(i, 1) = i - 1
        d(A(i, 1)) = i
    Next i

    [c2].Resize(UBound(A)) = B
End Sub

就需要下一个功能了