[已解决]数据量加大公式为何算不了

mhjbgf

行号改到5500时再算反应都没有,要怎么办看附件, Book1.rar (7.28 KB, 下载次数: 26)

2011-12-2 09:57 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

wayy

2011-12-2 11:29

mhjbgf 发表于 2011-12-2 11:04
你这个算起来快,但结果跟公式结果不一样,假设A列有两个"1"或三个,1这个数就不要,只显示出现过一次的.

1. Sub wayy2()
   
2. Dim i As Long
   
3. Dim arr, arr1, arr2, arrz
   
4. Dim d As Object
   
5. Dim mrow As Long
   
6. Set d = CreateObject("Scripting.Dictionary")
   
7. arr = Range("A2", [a65536].End(xlUp))
   
8. For i = 1 To UBound(arr)
   
9.   d(arr(i, 1)) = 1 + d(arr(i, 1))
   
10. Next
    
11. ReDim arrz(1 To d.Count, 1 To 1)
    
12. arr2 = Application.Transpose(d.Items)
    
13. arr1 = Application.Transpose(d.keys)
    
14. For i = 1 To d.Count
    
15.     If arr2(i, 1) = 1 Then
    
16.       mrow = mrow + 1
    
17.       arrz(mrow, 1) = arr1(i, 1)
    
18.     End If
    
19. Next
    
20. [b2].Resize(mrow, 1) = arrz
    
21. End Sub

复制代码

没看明白，你也没说明白题意，改了下，再看看，公式结果好像少了一个值45

跳转到最佳答案楼层

安全为主

有反应的，就是慢！！！范围多要改的。

yuhe0008

改用其他方法，比如高级筛选（不重复记录）或数据透视表

wayy

不要用代码写公式，要不然会被某某BS的。
公式中使用COUNTIF时不要量太大。

业余爱好者

能操作完成的,还是不要用公式了

效率优先

wayy

1. Sub wayy()
   
2. Dim i As Long
   
3. Dim arr
   
4. Dim d As Object
   
5. Set d = CreateObject("Scripting.Dictionary")
   
6. arr = Range("A2", [a65536].End(xlUp))
   
7. For i = 1 To UBound(arr)
   
8.   d(arr(i, 1)) = ""
   
9. Next
   
10. [b2].Resize(d.Count, 1) = Application.Transpose(d.keys)
    
11. End Sub

复制代码

不重复值使用代码时字典是比较方便的。

mhjbgf

wayy 发表于 2011-12-2 10:22
不重复值使用代码时字典是比较方便的。

你这个算起来快,但结果跟公式结果不一样,假设A列有两个"1"或三个,1这个数就不要,只显示出现过一次的.

wayy

mhjbgf 发表于 2011-12-2 11:04
你这个算起来快,但结果跟公式结果不一样,假设A列有两个"1"或三个,1这个数就不要,只显示出现过一次的.

1. Sub wayy2()
   
2. Dim i As Long
   
3. Dim arr, arr1, arr2, arrz
   
4. Dim d As Object
   
5. Dim mrow As Long
   
6. Set d = CreateObject("Scripting.Dictionary")
   
7. arr = Range("A2", [a65536].End(xlUp))
   
8. For i = 1 To UBound(arr)
   
9.   d(arr(i, 1)) = 1 + d(arr(i, 1))
   
10. Next
    
11. ReDim arrz(1 To d.Count, 1 To 1)
    
12. arr2 = Application.Transpose(d.Items)
    
13. arr1 = Application.Transpose(d.keys)
    
14. For i = 1 To d.Count
    
15.     If arr2(i, 1) = 1 Then
    
16.       mrow = mrow + 1
    
17.       arrz(mrow, 1) = arr1(i, 1)
    
18.     End If
    
19. Next
    
20. [b2].Resize(mrow, 1) = arrz
    
21. End Sub

复制代码

没看明白，你也没说明白题意，改了下，再看看，公式结果好像少了一个值45

mhjbgf

wayy 发表于 2011-12-2 11:29
没看明白，你也没说明白题意，改了下，再看看，公式结果好像少了一个值45

行,就是结果不是按顺从小到大排下来,非常非常感谢老.师.