设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1034|回复: 3

VBA二维数组按第二参数排序

[复制链接]

点击这里给我发消息

发表于 2013-5-13 07:41:22 | 显示全部楼层 |阅读模式

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

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

x
本帖最后由 清风明月10 于 2013-5-13 08:00 编辑

游客,本付费内容需要支付 3D豆 才能浏览   这是一个广告位购买


'自定义函数
Function
游客,本付费内容需要支付 10D豆 才能浏览   这是一个广告位购买
(将要排序的数组, 第2参数的第几列如果是一维填1即可, 升序1降序非1)    '(将要排序的数组[将要排序的数组], 第2参数的第几列如果是一维填1即可[垂直数组(y,x)中x,像表格中的哪一列], 升序1降序非1[=1,升序;<>1,降序])
    '自定义函数中不能有“Application.Transpose”转置函数,否则CAD中不能使用
    Dim t, x&, y&, i&, j&, k&
    Dim 数组维数 As New 数组排序
AD = 数组维数.判断数组维数(将要排序的数组)
    '这个IF是,如果如果是一维就转为二维。如果是二维,则看“第2参数的第几列如果是一维填1即可”该列的序号是否和数组吻合。
    If AD = 2 Then
        '。如果是二维,则看“第2参数的第几列如果是一维填1即可”该列的序号是否和数组吻合。不吻合就退出自定义函数
        If Not (第2参数的第几列如果是一维填1即可 >= LBound(将要排序的数组, 2) And 第2参数的第几列如果是一维填1即可 <= UBound(将要排序的数组, 2)) Then Exit Function
     Else
        Exit Function
    End If
    y = LBound(将要排序的数组, 1)
    x = LBound(将要排序的数组, 2)
    If 升序1降序非1 = 1 Then    '升序
        For i = y To UBound(将要排序的数组) - 1
            For j = i + 1 To UBound(将要排序的数组)
                If 将要排序的数组(j, 第2参数的第几列如果是一维填1即可) < 将要排序的数组(i, 第2参数的第几列如果是一维填1即可) Then    '冒泡排序法
                    '这句话是将J行的数据N个与I行的数据N个互换
                    For k = x To UBound(将要排序的数组, 2)
                        t = 将要排序的数组(j, k): 将要排序的数组(j, k) = 将要排序的数组(i, k): 将要排序的数组(i, k) = t
                    Next
                End If
            Next
        Next
    Else    '降序
        For i = y To UBound(将要排序的数组) - 1
            For j = i + 1 To UBound(将要排序的数组)
                If 将要排序的数组(j, 第2参数的第几列如果是一维填1即可) > 将要排序的数组(i, 第2参数的第几列如果是一维填1即可) Then
                   '这句话是将J行的数据N个与I行的数据N个互换
                   For k = x To UBound(将要排序的数组, 2)
                        t = 将要排序的数组(j, k): 将要排序的数组(j, k) = 将要排序的数组(i, k): 将要排序的数组(i, k) = t
                    Next
                End If
            Next
        Next
    End If

   二维数组按第二参数排序 = 将要排序的数组
End Function

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

点击这里给我发消息

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

使用道具 举报

点击这里给我发消息

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

使用道具 举报

点击这里给我发消息

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2019-9-19 21:03 , Processed in 0.130708 second(s), 26 queries , Gzip On, WinCache On.

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

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