Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2698|回复: 10

[已解决]求个vba

[复制链接]
发表于 2012-2-23 16:39 | 显示全部楼层 |阅读模式
Book1.xls23.rar (5.26 KB, 下载次数: 15)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2012-2-23 17:27 | 显示全部楼层
  1. Sub yy()
  2. Dim Arr, i&, r%, Arr1()
  3. Dim d, k, t
  4. Set d = CreateObject("Scripting.Dictionary")
  5. Sheet1.Activate
  6. Arr = [a10].CurrentRegion
  7. For i = 1 To UBound(Arr)
  8.     d(Arr(i, 1)) = d(Arr(i, 1)) + 1
  9. Next
  10. k = d.keys
  11. t = d.items
  12. For i = 0 To UBound(k)
  13.     If t(i) >= 2 And t(i) <= 5 Then
  14.         r = r + 1
  15.         ReDim Preserve Arr1(1 To r)
  16.         Arr1(r) = k(i)
  17.     End If
  18. Next
  19. Columns("b:b").NumberFormatLocal = "@"
  20. [b10].Resize(r) = Application.Transpose(Arr1)
  21. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2012-2-23 17:36 | 显示全部楼层
蓝桥玄霜 发表于 2012-2-23 17:27

结果没有从小到大排, 000最小,999最大
回复

使用道具 举报

发表于 2012-2-23 17:53 | 显示全部楼层
本帖最后由 zjdh 于 2012-2-23 17:58 编辑

找数.rar (12.5 KB, 下载次数: 3)
回复

使用道具 举报

 楼主| 发表于 2012-2-23 20:04 | 显示全部楼层
zjdh 发表于 2012-2-23 18:50

还有一个问题0显示不了,设置格式也没用 , 我重传了个附件 找数2.rar (24.96 KB, 下载次数: 4)
回复

使用道具 举报

发表于 2012-2-23 18:50 | 显示全部楼层
找数2.rar (12.56 KB, 下载次数: 3)
回复

使用道具 举报

 楼主| 发表于 2012-2-23 18:06 | 显示全部楼层
zjdh 发表于 2012-2-23 17:53

想从b10开始向下显示, b1改b10怎么没用
回复

使用道具 举报

发表于 2012-2-23 20:32 | 显示全部楼层    本楼为最佳答案   
6楼附件不是可以的吗?怎么又变位置了?
找数3.rar (24.14 KB, 下载次数: 8)
回复

使用道具 举报

发表于 2012-2-23 20:38 | 显示全部楼层
Sub TEST()下面加句
  1. Range("g:g").NumberFormatLocal = "@"
复制代码
回复

使用道具 举报

 楼主| 发表于 2012-2-23 21:05 | 显示全部楼层
zjdh 发表于 2012-2-23 20:32
6楼附件不是可以的吗?怎么又变位置了?

还得再麻烦你,如果我把结果设在g15,那g1到g14格原有数据全消失.
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 22:20 , Processed in 0.430952 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表