EXCEL自动排序VBA代码.doc_第1页
EXCEL自动排序VBA代码.doc_第2页
EXCEL自动排序VBA代码.doc_第3页
EXCEL自动排序VBA代码.doc_第4页
全文预览已结束

下载本文档

版权说明:本文档由用户提供并上传,收益归属内容提供方,若内容存在侵权,请进行举报或认领

文档简介

Sub 单列自动排序() a为需要排序的数组,up为True则为升序排列,为False,则为降序排列。 Dim up As Boolean Dim ranktype As String Dim i As Integer, j As Integer Dim temp As Double, temp1 As Integer Dim a(1000, 3) As Double a数组定义大小要超过排序数,此处是按排序数在1000个以内定义 * colnum = 1 排序数据列 rankcolnum = 2 排序码列 startrow = 5 排序数据起始行号 endrow = 135 排序数据末尾行号 ranktype = 降序 排序方式,“升序”或“降序” If ranktype = 升序 Then up = True Else up = False End If For i = 1 To endrow - startrow + 1 a(i, 0) = Val(ActiveSheet.Cells(startrow + i - 1, colnum) a(i, 1) = startrow + i - 1 a(i, 2) = 0 Next * For i = 1 To endrow - startrow 进行n-1轮比较 For j = endrow - startrow + 1 To i + 1 Step -1 从n到i个元素两两进行比较 If up Then 判断升降序 If a(j, 0) a(j - 1, 0) Then temp = a(j, 0) temp1 = a(j, 1) a(j, 0) = a(j - 1, 0) a(j, 1) = a(j - 1, 1) a(j - 1, 0) = temp a(j - 1, 1) = temp1 End If End If Next j Next i For i = 1 To endrow - startrow + 1 a(i, 2) = i Next For i = 2 To endrow - startrow + 1 If a(i, 0) = a(i - 1, 0) Then a(i, 2) = a(i - 1, 2) End If Next For i = 1 To endrow - startrow + 1 ActiveSheet.Cells(a(i, 1), rankcolnum) = a(i, 2) Next End Sub数据自动排序(单列间隔)Sub 自动排序1() a为需要排序的数组,up为True则为升序排列,为False,则为降序排列。 Dim up As Boolean up = False Dim i As Integer, j As Integer Dim temp As Double, temp1 As Integer For colnum = 1 To 9 9为需要排序的数据列数Dim a(100, 3) As Double * startrow = 3 排序数据起始行号 endrow = 20 排序数据末尾行号 For i = 1 To endrow - startrow + 1 a(i, 0) = Val(ActiveSheet.Cells(startrow + i - 1, (colnum - 1) * 2 + 4) a(i, 1) = startrow + i - 1 a(i, 2) = 0 Next * For i = 1 To endrow - startrow 进行n-1轮比较 For j = endrow - startrow + 1 To i + 1 Step -1 从n到i个元素两两进行比较 If up Then 判断升降序 If a(j, 0) a(j - 1, 0) Then temp = a(j, 0) temp1 = a(j, 1) a(j, 0) = a(j - 1, 0) a(j, 1) = a(j - 1, 1) a(j - 1, 0) = temp a(j - 1, 1) = temp1 End If End If Next j Next i For i = 1 To endrow - startrow + 1 a(i, 2) = i Next For i = 2 To endrow - startrow + 1 If a(i, 0) = a(i - 1, 0) Then a(i, 2) = a(i - 1, 2) End If Next For i = 1

温馨提示

  • 1. 本站所有资源如无特殊说明,都需要本地电脑安装OFFICE2007和PDF阅读器。图纸软件为CAD,CAXA,PROE,UG,SolidWorks等.压缩文件请下载最新的WinRAR软件解压。
  • 2. 本站的文档不包含任何第三方提供的附件图纸等,如果需要附件,请联系上传者。文件的所有权益归上传用户所有。
  • 3. 本站RAR压缩包中若带图纸,网页内容里面会有图纸预览,若没有图纸预览就没有图纸。
  • 4. 未经权益所有人同意不得将文件中的内容挪作商业或盈利用途。
  • 5. 人人文库网仅提供信息存储空间,仅对用户上传内容的表现方式做保护处理,对用户上传分享的文档内容本身不做任何修改或编辑,并不能对任何下载内容负责。
  • 6. 下载文件中如有侵权或不适当内容,请与我们联系,我们立即纠正。
  • 7. 本站不保证下载资源的准确性、安全性和完整性, 同时也不承担用户因使用这些下载资源对自己和他人造成任何形式的伤害或损失。

评论

0/150

提交评论