Excel精英培训网

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

[已解决]判断最近不同147,258,369的尾数

[复制链接]
发表于 2015-1-9 18:32 | 显示全部楼层 |阅读模式
本帖最后由 hanjia 于 2015-1-9 19:11 编辑

在函数求助无果   来VBA求助
A1是147尾数   提取第一位数字后   再查找最近不要相同的另外俩位第二位和第三位尾数
第二位数尾数不要和第一位尾数相同      第三位不要和第一位跟第二位相同

用什么公式判断最近不同147,258,369的尾数,  并提取出来最近三个不同的尾数
像下面C列:A1是147尾数,提取出第一位,A2,A3同样是属于147尾数就不再提取了  (7)
A4是369尾数跟第一位不相同  就提取第二个数     (3)
A5,A6,A7 跟前俩位的尾数又是相同的还是不提取
A8跟前面提取的不相同  就提取第三个数    (10)
这样提取出来的三个最近不同的尾数  (7,3,10)
最下面的是没有第三位跟第二位提取了才提取俩位和一位数

A                 C
7                7,3,10
7                7,3,10
7                7,3,10
3                3,1,10
9                9,1,10
1                1,6,10
6                6,10,8
10              10,8,7
8                8,10,7
10              10,7,8
10              10,7,8
7                7,8,9
1                1,8,9
8                8,4,9
4                4,8,9
8                8,1,9
1                1,5,9
5                5,7,9
5                5,7,9
5                5,7,9
2                2,7,9
7                7,2,9
2                2,5,9
5                5,9,8
9                9,8,10
8                8,6,10
8                8,6,11
6                6,8,10
6                6,8,11
8                8,10,7
10              10,8,7
8                8,7,10
7                7,2,10
2                2,10,1
10              10,1,2
1                1,2,9
2                2,1,9
2                2,1,9
5                5,1,9
2                2,1,9
2                2,1,9
5                5,1,9
5                5,1,9
5                5,1,9
8                8,1,9
1                1,2,9
2                2,9
5                5,9
2                2,9
2                2,9
9                9

工作表 (2).rar (6.53 KB, 下载次数: 7)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
 楼主| 发表于 2015-1-9 19:02 | 显示全部楼层
A1是147尾数   提取第一位数字后   再查找最近不要相同的另外俩位第二位和第三位尾数
第二位数尾数不要和第一位尾数相同      第三位不要和第一位跟第二位相同
回复

使用道具 举报

发表于 2015-1-10 12:38 | 显示全部楼层    本楼为最佳答案   
本帖最后由 dsmch 于 2015-1-10 12:58 编辑
  1. Sub Macro1()
  2. Dim arr, brr, d, i&, p$, p2$
  3. Set d = CreateObject("scripting.dictionary")
  4. arr = Range("a1").CurrentRegion
  5. ReDim brr(1 To UBound(arr), 1 To 1)
  6. For i = 1 To 7 Step 3
  7.     d(i) = 1
  8.     d(i + 1) = 2
  9.     d(i + 2) = 3
  10. Next
  11. d(10) = 4
  12. d(11) = 4
  13. For i = 1 To UBound(arr)
  14.     p = "": p2 = ""
  15.     For j = i To UBound(arr)
  16.         If InStr(p, d(arr(j, 1))) = 0 Then
  17.             p = p & d(arr(j, 1))
  18.             p2 = p2 & "," & arr(j, 1)
  19.         End If
  20.         If Len(p) = 3 Then Exit For
  21.     Next
  22.     brr(i, 1) = Mid(p2, 2)
  23. Next
  24. Range("d1").Resize(UBound(brr)) = brr
  25. End Sub
复制代码
回复

使用道具 举报

发表于 2015-1-10 13:00 | 显示全部楼层
………………

工作表 (2).zip

10.62 KB, 下载次数: 1

回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 09:10 , Processed in 0.401128 second(s), 7 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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