EXCEL自动排序VBA代码.doc
文本预览下载声明
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
Else
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(
显示全部