EXCEL自动排序VBA代码

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) = V al(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) = V al(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 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), (colnum - 1) * 2 + 5) = a(i, 2) Next

Next End Sub