找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 461|回复: 4

[求助] [功能]去重

[复制链接]

已领礼包: 604个

财富等级: 财运亨通

发表于 2016-11-4 15:26:27 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
这段去除的代码,在excel中如何看到运行的效果?或者换说怎么知道这段代码是否正确?
Sub RecSortTest()
    arr = Array(5, 4, 2, 1, 5, 8, 7, 2, 7, 9, 3, 6, "22", "23", "221", 22, 23, 221, "a", "z", "c") '测试数组
'    arr = WorksheetFunction.Transpose([a1].CurrentRegion) '如果工作表区域要转为一维数组
    trr = RecSort(arr) '仅排序(按默认格式)
    trr1 = RecSort(arr, 1) '去重复排序(按默认格式)
    trr2 = RecSort(arr, 1, 1) '去重复排序 数值不按文本格式
   'Stop
End Sub
'[功能]数组循环去重复 by 香川群子
Function RecSort(arr, Optional z& = 0, Optional c& = 0) 'A-Z 升序排序(/可去重复)的自定义过程
    Dim i&, j&, k&, l&, n&, u&, t
    l = LBound(arr): n = l: u = UBound(arr)
    ReDim trr(l To u)
    
    For i = l To u
        t = arr(i): If c Then If IsNumeric(t) Then t = Val(t) 'c=1 按数值/c=0 按源数据格式
        For j = l To n
            If z Then If trr(j) = t Then n = n - 1: Exit For 'z=1 去重复/z=0 保留
            If trr(j) > t Then '检查直到比当前值t大位置时停止
                For k = n To j + 1 Step -1 '倒序向后移动所有比当前值大的已排序内容 以便腾出空位
                    trr(k) = trr(k - 1)
                Next
                trr(k) = t '空位写入t
                Exit For
            End If
        Next
        If j > n Then trr(j - 1) = t '如果都没有比当前值大 则在最后新的位置写入t
        n = n + 1
    Next
    If z Then ReDim Preserve trr(l To n - 1)
    RecSort = trr
End Function
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 19个

财富等级: 恭喜发财

发表于 2016-11-4 15:27:31 | 显示全部楼层
这个是去什么重啊?

点评

excel中的运用  发表于 2016-11-4 15:58
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 40个

财富等级: 招财进宝

发表于 2016-11-4 20:24:44 | 显示全部楼层
EXCEL中,用宏,找找相关文献。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1304个

财富等级: 财源广进

发表于 2016-11-4 21:31:35 | 显示全部楼层
啥也不说了,感谢楼主分享哇!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-4-28 10:04 , Processed in 0.297838 second(s), 34 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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