Excel精英培训网

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

[已解决]VBA:如何提取出现相同次数的数据

[复制链接]
发表于 2014-12-10 00:13 | 显示全部楼层 |阅读模式
本帖最后由 lijian8003 于 2014-12-14 15:09 编辑

请看附件:
1、先统计第1行:B1-K1的数据中,有多少与A1数据相同,此例有3个
2、再统计第2行:B2-K2的数据中,出现3次的数据是19 24
3、然后提取第2行出现3次的数据19 24,并写入D:/数据/1.txt,数据间用空格分隔,数据末尾加回车键
如果第2行没有出现3次的数据,则在D:/数据/1.txt中写入空,并加回车键。
这样的VBA如何用数组方式表示?恳望得到帮助。
最佳答案
2014-12-10 08:45
  1. Sub Macro1()
  2. Dim arr, d, i&, j%, n%, k%
  3. Set d = CreateObject("scripting.dictionary")
  4. arr = [a1:k2]
  5. n = Application.CountIf([b1:k1], [a1])
  6. '测试路径:ThisWorkbook.Path & "\1.txt"
  7. Open ThisWorkbook.Path & "\1.txt" For Output As #1
  8. For i = 2 To 2 '数组行
  9.     For j = 2 To UBound(arr, 2)
  10.         d(arr(i, j)) = d(arr(i, j)) + 1
  11.     Next
  12.     a = d.keys: b = d.items: p = ""
  13.     For k = 0 To d.Count - 1
  14.         If b(k) = n Then p = p & a(k) & " "
  15.     Next
  16.     Print #1, p
  17.     d.RemoveAll
  18. Next
  19. Close #1
  20. End Sub
复制代码

提取出现同样次数的数据.zip

6.5 KB, 下载次数: 14

发表于 2014-12-10 08:45 | 显示全部楼层    本楼为最佳答案   
  1. Sub Macro1()
  2. Dim arr, d, i&, j%, n%, k%
  3. Set d = CreateObject("scripting.dictionary")
  4. arr = [a1:k2]
  5. n = Application.CountIf([b1:k1], [a1])
  6. '测试路径:ThisWorkbook.Path & "\1.txt"
  7. Open ThisWorkbook.Path & "\1.txt" For Output As #1
  8. For i = 2 To 2 '数组行
  9.     For j = 2 To UBound(arr, 2)
  10.         d(arr(i, j)) = d(arr(i, j)) + 1
  11.     Next
  12.     a = d.keys: b = d.items: p = ""
  13.     For k = 0 To d.Count - 1
  14.         If b(k) = n Then p = p & a(k) & " "
  15.     Next
  16.     Print #1, p
  17.     d.RemoveAll
  18. Next
  19. Close #1
  20. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
lijian8003 + 3 赞一个!

查看全部评分

回复

使用道具 举报

发表于 2014-12-10 08:47 | 显示全部楼层
………………

1.rar

9.25 KB, 下载次数: 12

回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 03:48 , Processed in 0.591797 second(s), 14 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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