Excel精英培训网

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

[已解决]按要求求得结果

[复制链接]
发表于 2015-4-17 15:26 | 显示全部楼层 |阅读模式
本帖最后由 excelpxfans001 于 2015-4-18 00:27 编辑

按要求求得结果,见附件。

由于附件大小限500K,示例数据提供少。
最佳答案
2015-4-17 19:43
换个思路要快一点
  1. Sub ttt()
  2.     arr = Sheet1.[a1].CurrentRegion
  3.     c = UBound(arr, 2)
  4.     Set d = CreateObject("scripting.dictionary")
  5.     ReDim brr(0 To 100000, 0 To c)
  6.     ReDim n(0 To c)
  7.     brr(0, 0) = "0个"
  8.     For j = 1 To c
  9.         brr(0, j) = j & "个"
  10.         For i = 1 To UBound(arr)
  11.             If arr(i, j) <> "" Then
  12.                 x = arr(i, j) & "," & j         '数值+列数
  13.                 If Not d.exists(x) Then
  14.                     d(x) = ""
  15.                     d(arr(i, j)) = d(arr(i, j)) + 1
  16.                 End If
  17.             End If
  18.         Next
  19.     Next

  20.     For i = 0 To 99999
  21.         s = d(i)
  22.         n(s) = n(s) + 1
  23.         brr(n(s), s) = i
  24.     Next
  25.     With Sheet4
  26.         .Cells.Clear
  27.         .[a1].Resize(Application.Max(n), c + 1) = brr
  28.         .Activate
  29.     End With
  30. End Sub
复制代码

求助00000.rar

36.02 KB, 下载次数: 13

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2015-4-17 15:53 | 显示全部楼层
回复

使用道具 举报

 楼主| 发表于 2015-4-17 16:00 | 显示全部楼层
grf1973 发表于 2015-4-17 15:53
不知所云

提供数据全部为00000-99999的五位数,现分别把提供的数据在00000-99999中未出现的,,只其中一列才有的,只其中两列才有的,只其中三列才有的等等,统计出来。
回复

使用道具 举报

发表于 2015-4-17 16:03 | 显示全部楼层
就是算有和没有的问题哈?这个好办,只是对你的要求读不懂。请把问题描述清楚
回复

使用道具 举报

 楼主| 发表于 2015-4-17 16:14 | 显示全部楼层
pengyx 发表于 2015-4-17 16:03
就是算有和没有的问题哈?这个好办,只是对你的要求读不懂。请把问题描述清楚

感觉还是比较复杂的。

1,在00000-99999中未出现的。
2.提供的数据中,只其中一列含有的数据
3,提供的数据中,只其中二列含有的数据
4.提供的数据中,只其中三列含有的数据
依次等等求出。

考虑到提供的数据列数是有增减的。所以还是有点麻烦的。
回复

使用道具 举报

发表于 2015-4-17 16:23 | 显示全部楼层
问题1、“在00000-99999中未出现的。”是什么意思?是小于或大于99999的吗?但你只有5位数,如何大于99999?请说清楚
2、“只其中一列含有的数据”是只有哪一列有的数,A列有的和B列有的是不一样的,如果你有上百列,我是不是要给你写上百个数?你给的格式即sheet3能让我写上百个数吗?请说清楚
总之你没把问题说清楚,当然比较复杂。
VBA只有你想不到没有做不到。
回复

使用道具 举报

发表于 2015-4-17 16:52 | 显示全部楼层
  1. Sub tt()
  2.     arr = [a1].CurrentRegion
  3.     ReDim d(UBound(arr, 2)) As Object
  4.     For j = 1 To UBound(arr, 2)
  5.         Set d(j) = CreateObject("scripting.dictionary")
  6.         For i = 1 To UBound(arr)
  7.             If arr(i, j) <> "" Then d(j)(arr(i, j)) = 1
  8.         Next
  9.     Next
  10.     Set dd = CreateObject("scripting.dictionary")
  11.     For i = 0 To 99999
  12.         s = 0
  13.         For j = 1 To UBound(arr, 2)
  14.             If d(j)(i) = 1 Then s = s + 1
  15.         Next
  16.         x = "出现" & s & "列的数值个数"
  17.         dd(x) = dd(x) + 1
  18.     Next
  19.     [j1].Resize(dd.Count, 2) = Application.Transpose(Array(dd.keys, dd.items))
  20.     [j1].Resize(dd.Count, 2).Sort key1:=[j1]
  21. End Sub
复制代码

求助00000.rar

42.42 KB, 下载次数: 2

回复

使用道具 举报

 楼主| 发表于 2015-4-17 16:55 | 显示全部楼层
本帖最后由 excelpxfans001 于 2015-4-17 16:58 编辑
grf1973 发表于 2015-4-17 16:52

你好,老师,是要把各结果分别罗列出来结果放在sheet3里,不只是统计个数。

比如未出现有99911个,那么要把这些数据全部填入sheet3的A列。从A3开始填入,第一行填入个数,第二行标示不含的。


求出的结果附件会很大,可以提供代码即可。
回复

使用道具 举报

发表于 2015-4-17 19:29 | 显示全部楼层
  1. Sub tt()
  2.     arr = [a1].CurrentRegion
  3.     c = UBound(arr, 2)
  4.     ReDim d(1 To c) As Object
  5.     ReDim brr(0 To 100000, 0 To c)
  6.     ReDim n(0 To c)
  7.     brr(0, 0) = "0个"
  8.     For j = 1 To c
  9.         brr(0, j) = j & "个"
  10.         Set d(j) = CreateObject("scripting.dictionary")
  11.         For i = 1 To UBound(arr)
  12.             If arr(i, j) <> "" Then d(j)(arr(i, j)) = 1
  13.         Next
  14.     Next
  15.    
  16.     For i = 0 To 99999
  17.         s = 0
  18.         For j = 1 To c
  19.             If d(j)(i) = 1 Then s = s + 1
  20.         Next
  21.         n(s) = n(s) + 1
  22.         brr(n(s), s) = i
  23.     Next
  24.     With Sheet2
  25.         .Cells.Clear
  26.         .[a1].Resize(Application.Max(n), c + 1) = brr
  27.         .Activate
  28.     End With
  29. End Sub
复制代码
回复

使用道具 举报

发表于 2015-4-17 19:43 | 显示全部楼层    本楼为最佳答案   
换个思路要快一点
  1. Sub ttt()
  2.     arr = Sheet1.[a1].CurrentRegion
  3.     c = UBound(arr, 2)
  4.     Set d = CreateObject("scripting.dictionary")
  5.     ReDim brr(0 To 100000, 0 To c)
  6.     ReDim n(0 To c)
  7.     brr(0, 0) = "0个"
  8.     For j = 1 To c
  9.         brr(0, j) = j & "个"
  10.         For i = 1 To UBound(arr)
  11.             If arr(i, j) <> "" Then
  12.                 x = arr(i, j) & "," & j         '数值+列数
  13.                 If Not d.exists(x) Then
  14.                     d(x) = ""
  15.                     d(arr(i, j)) = d(arr(i, j)) + 1
  16.                 End If
  17.             End If
  18.         Next
  19.     Next

  20.     For i = 0 To 99999
  21.         s = d(i)
  22.         n(s) = n(s) + 1
  23.         brr(n(s), s) = i
  24.     Next
  25.     With Sheet4
  26.         .Cells.Clear
  27.         .[a1].Resize(Application.Max(n), c + 1) = brr
  28.         .Activate
  29.     End With
  30. End Sub
复制代码

求助00000.zip

714.77 KB, 下载次数: 14

回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-28 21:56 , Processed in 0.685667 second(s), 9 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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