欢迎登陆真网站,您的到来是我们的荣幸。 登陆 注册 忘记密码? ☆设为首页 △加入收藏
欢迎加入真幸福QQ群
电脑知识: 基础知识 网络技术 操作系统 办公软件 电脑维修 电脑安全 windows7 windows8 windows10 服务器教程 平板电脑 视频播放教程 网络应用 互联网 工具软件 浏览器教程 QQ技巧 输入法教程 影视制作 YY教程 wps教程 word教程 Excel教程 PowerPoint
云南西双版纳特产小花糯玉米真空包装


Excel Range Clear的联合使用
Excel MMULT计算过程
excel Iseven Isodd 判断奇偶
Excel月日不足10在前面添0的公式代码
半角全角互转函数jis和asc
Excel排列函数permut
win7电脑的快速启动栏消失了怎么办?
project和word,excel之间的转换
SUMSQ平方和函数
Excel构造有规律数据实例1,1.1,2,2.1,3,3.1
VBA数组的升序、降序
【 来源:网络 】【 点击:2 】 【 发布时间:2017_03_03 08:59:59 】

   ①升序排序的VBA数组

  Function UP(x()) As Variant()

  Dim i As Integer, j As Integer, a, d()

  ReDim sx(LBound(x) To UBound(x)), d(LBound(x) To UBound(x))

  d = x

  If LBound(x) = UBound(x) Then

  sx = d

  Exit Function

  End If

  For i = LBound(x) To UBound(x) - 1

  For j = i + 1 To UBound(x)

  If d(j) < d(i) Then

  a = d(j): d(j) = d(i): d(i) = a

  End If

  Next

  Next

  sx = d

  End Function

  ②VBA数组的降序排序

  Function Down(x()) As Variant()

  Dim i As Integer, j As Integer, a, d()

  ReDim sx(LBound(x) To UBound(x)), d(LBound(x) To UBound(x))

  d = x

  If LBound(x) = UBound(x) Then

  sx = d

  Exit Function

  End If

  For i = LBound(x) To UBound(x) - 1

  For j = i + 1 To UBound(x)

  If d(j) > d(i) Then

  a = d(j): d(j) = d(i): d(i) = a

  End If

  Next

  Next

  sx = d

  End Function

  ③针对中文字符的数组排序

  如果你想针对字符数组进行排序,可参考如下的代码

  Sub Start() Dim arr() As Variant arr = Array("大", "众", "计", "算", "机", "学", "习", "网")

  QuickSort2 arr(), 0, UBound(arr) Dim s As String For I = 1 To UBound(arr) s = s & arr(I) & " | " Next MsgBox s

  End Sub Sub QuickSort2(MyArray() As Variant, L, R) Dim tp tp = 1

  Dim I, J, X, Y I = L J = R X = MyArray((L + R) / 2) While (I <= J) While (StrComp(MyArray(I), X, tp) < 0 And I < R) I = I + 1 Wend While (StrComp(X, MyArray(J), tp) < 0 And J > L) J = J - 1 Wend If (I <= J) Then Y = MyArray(I) MyArray(I) = MyArray(J) MyArray(J) = Y I = I + 1 J = J - 1 End If gIterations = gIterations + 1 Wend

  If (L < J) Then Call QuickSort2(MyArray(), L, J) If (I < R) Then Call QuickSort2(MyArray(), I, R)

  End Sub

本网站由川南居提供技术支持,fkzxf版权所有 浙ICP备12031891号
淳安分站 淳安分站