[已解决]去年重复值留下唯一的值 ，要求运行速度快，求助！·！

双飞叶

根据总表得出唯一值，要求：
1、不要用数组，因为总表数据要达到上万行，而且列数有多列，用了数组，运行速度就慢了。
2、尽量要求运行速度快，可以和公式函数或者VBA。

Book1.rar (2.29 KB, 下载次数: 13)

2013-1-5 20:26 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

zhoucs00

2013-1-5 21:19

双飞叶 发表于 2013-1-5 21:14
每次在汇总表增加内容,唯一值自动更新

1. Sub zhoucs00()
   
2. Dim arr, brr, crr, err, drr, i As Integer
   
3. arr = Sheets("总表").Range("A3:A" & Sheets("总表").Cells(Rows.Count, 1).End(3).Row)
   
4. drr = Sheets("总表").Range("B3:B" & Sheets("总表").Cells(Rows.Count, 2).End(3).Row)
   
5. On Error Resume Next
   
6. With CreateObject("scripting.dictionary")
   
7.    For i = 1 To UBound(arr)
   
8.       .Add arr(i, 1), ""
   
9.    Next i
   
10.    err = .keys
    
11.    Sheets("唯一值").Range("A4").Resize(.Count, 1) = Application.WorksheetFunction.Transpose(err)
    
12. End With
    
13. With CreateObject("scripting.dictionary")
    
14.    For i = 1 To UBound(drr)
    
15.       .Add drr(i, 1), ""
    
16.    Next i
    
17.    crr = .keys
    
18.    Sheets("唯一值").Range("A4").Offset(0, 1).Resize(.Count, 1) = Application.WorksheetFunction.Transpose(crr)
    
19. End With
    
20. End Sub

复制代码

这段代码，更新时，重新运行一下就是了

跳转到最佳答案楼层

CheryBTL

金额是怎么算的呢？
如果上万行，就用数据透视表好了，快捷方便。
选择源数据所在区域任一位置——>ALT+D+P——>完成
在新的数据透视表上，将姓名放拖到行标签即可。

w1098

1. select distinct 姓名,first(金额) as 金额 from[总表$] group by 姓名

复制代码

sql查询。速度快，数据量大时优势明显

zhoucs00

1. Sub zhoucs00()
   
2. Dim arr, brr, crr, i As Integer
   
3. arr = Sheets("总表").Range("A3:B" & Sheets("总表").Cells(Rows.Count, 1).End(3).Row)
   
4. On Error Resume Next
   
5. With CreateObject("scripting.dictionary")
   
6.    For i = 1 To UBound(arr, 1)
   
7.       .Add arr(i, 1), arr(i, 2)
   
8.    Next i
   
9.    arr = .keys
   
10.    crr = .items
    
11.    Sheets("唯一值").Range("A4").Resize(.Count, 1) = Application.WorksheetFunction.Transpose(arr)
    
12.    Sheets("唯一值").Range("A4").Offset(0, 1).Resize(.Count, 1) = Application.WorksheetFunction.Transpose(crr)
    
13. End With
    
14. End Sub
    

复制代码

试下这段代码，看你模拟的结果并没有将张三的不同金额汇总，而是取了第一个，我也就直接取了第一个了

双飞叶

CheryBTL 发表于 2013-1-5 20:42
金额是怎么算的呢？
如果上万行，就用数据透视表好了，快捷方便。
选择源数据所在区域任一位置——>ALT+D ...

数据透视表固然是好，就是每次在汇总表增加内容，都要刷新后数据才会更新，不会自动更新，这点不太方便。

双飞叶

zhoucs00 发表于 2013-1-5 20:51
试下这段代码，看你模拟的结果并没有将张三的不同金额汇总，而是取了第一个，我也就直接取了第一个了

很不错，但与要求不太相符，估计是我描述有误，列与列没有对等关系，只要把每一列的唯一值提取出来就行。
能修改一下吗

双飞叶

w1098 发表于 2013-1-5 20:51
sql查询。速度快，数据量大时优势明显

很不错，但与要求不太相符，估计是我描述有误，列与列没有对等关系，只要把每一列的唯一值提取出来就行。
能修改一下吗

双飞叶

每次在汇总表增加内容,唯一值自动更新

zhoucs00

双飞叶 发表于 2013-1-5 21:14
每次在汇总表增加内容,唯一值自动更新

1. Sub zhoucs00()
   
2. Dim arr, brr, crr, err, drr, i As Integer
   
3. arr = Sheets("总表").Range("A3:A" & Sheets("总表").Cells(Rows.Count, 1).End(3).Row)
   
4. drr = Sheets("总表").Range("B3:B" & Sheets("总表").Cells(Rows.Count, 2).End(3).Row)
   
5. On Error Resume Next
   
6. With CreateObject("scripting.dictionary")
   
7.    For i = 1 To UBound(arr)
   
8.       .Add arr(i, 1), ""
   
9.    Next i
   
10.    err = .keys
    
11.    Sheets("唯一值").Range("A4").Resize(.Count, 1) = Application.WorksheetFunction.Transpose(err)
    
12. End With
    
13. With CreateObject("scripting.dictionary")
    
14.    For i = 1 To UBound(drr)
    
15.       .Add drr(i, 1), ""
    
16.    Next i
    
17.    crr = .keys
    
18.    Sheets("唯一值").Range("A4").Offset(0, 1).Resize(.Count, 1) = Application.WorksheetFunction.Transpose(crr)
    
19. End With
    
20. End Sub

复制代码

这段代码，更新时，重新运行一下就是了

双飞叶

zhoucs00 发表于 2013-1-5 21:19
这段代码，更新时，重新运行一下就是了

不错，就是这种效果
要是能加入点保存时自动更新或者新打开工作表时自动更新，这样就更完美了