提取指定行区间内的不重复值

peterwjs

大家好：
     这几天单位要写个报表，数据量很大，需要在指定区域内提取不重复值，在网上看了不少资料，只能对整个表提取不重复值，而我现在需要对数据源中符合当前条件的区域进行提取不重复值，搞了两天还是没有搞成，那位师傅能帮我一下吗。原文件见附件

hyefeifei

见附件： 数据.rar (47.81 KB, 下载次数: 121)

2016-3-22 21:11 上传

点击文件名下载附件

林花谢了再来

1. Private Sub SpinButton1_Change()
   
2.    Dim arr
   
3.     Dim frow, erow
   
4.     Sheets("目标").Range("H2:H200").ClearContents
   
5.     t = DateAdd("s", 1, Now)
   
6.     Do Until Now > t
   
7.         DoEvents
   
8.     Loop
   
9.     frow = Sheets("目标").[B6]
   
10.     erow = Sheets("目标").[B7]
    
11.    
    
12.     If Not IsNumeric(frow) Or Not IsNumeric(erow) Then
    
13.         MsgBox "行数应为数字"
    
14.         Exit Sub
    
15.     End If
    
16.     arr = Sheets("数据源").Range("G" & frow & ":G" & erow)
    
17.    
    
18.     Set d = CreateObject("Scripting.Dictionary")
    
19.     For i = 1 To UBound(arr)
    
20.         d(arr(i, 1)) = ""
    
21.     Next
    
22.     k = d.keys
    
23.     Sheets("目标").[H2].Resize(d.Count, 1) = Application.Transpose(k)
    
24.     Sheets("目标").[I2] = frow
    
25.     Sheets("目标").[I3] = erow
    
26. End Sub
    

复制代码

peterwjs

林花谢了再来 发表于 2016-3-22 21:40

学VBA有一小段时间，还没有学到字典的用法，这段代码我读了几遍，有三个位置没有看懂，请赐教！！
Private Sub SpinButton1_Change()
   Dim arr                                                            '定义起始行
    Dim frow, erow                                                    '定义起始行
    Sheets("目标").Range("H2:H200").ClearContents                     '清除目标   
'********************************************
    t = DateAdd("s", 1, Now)                                      '******这段代码不懂，请赐教******
    Do Until Now > t                                                   '* ??????                                              *
        DoEvents                                                          '*                                                        *
    Loop                                                                     '*                                                       *
                                                                             '********************************
'*********************************************
    frow = Sheets("目标").[B6]                                         '筛选区域第一行行号
    erow = Sheets("目标").[B7]                                         '筛选区域最后一行行号   
    If Not IsNumeric(frow) Or Not IsNumeric(erow) Then
        MsgBox "无停工"
        Exit Sub
    End If
'判断返回的是否为数据
'***********************************************
    arr = Sheets("数据源").Range("G" & frow & ":G" & erow)            '筛选区域数组等于数据源G列起始区间
   
    Set d = CreateObject("Scripting.Dictionary")                             '创建一个字典对象
    For i = 1 To UBound(arr)                                                        'for循环1到数据上限
        d(arr(i, 1)) = ""                                                              '????????????
    Next
    k = d.keys                                                                                
    Sheets("目标").[H2].Resize(d.Count, 1) = Application.Transpose(k)      '???????????

'*************************************************
    'Sheets("目标").[I2] = frow
    'Sheets("目标").[I3] = erow
End Sub

林花谢了再来

t = DateAdd("s", 1, Now)                                      '************
    Do Until Now > t                                                   '* 这段是为了延时，你的公式计算太慢，目的是为了让公式计算完后再执行，其实可以将公式加到程序中就没什么问题了                                           *
        DoEvents                                                          '*                                                        *
    Loop   

d(arr(i, 1)) = ""    这是典型的字典用法，将数组中的值赋给字典，将重复值去掉

Sheets("目标").[H2].Resize(d.Count, 1) = Application.Transpose(k) 由于k是一维数组，也就是一行，必须通过转置变成列放到目标区               

peterwjs

谢谢！！看来你不是新手，是高手