返回目录：excel表格制作
假设源数百据在A列，度排好的数据输出到专B列，代码如下：属
Sub s()
Dim arr, i, j, n, tmp
n = Cells(Rows.Count, 1).End(3).Row
arr = [a1].Resize(n)
For i = 2 To n
For j = n To i Step -1
If arr(j, 1) < arr(j - 1, 1) Then
tmp = arr(j, 1)
arr(j, 1) = arr(j - 1, 1)
arr(j - 1, 1) = tmp
End If
Next
Next
[b1].Resize(n) = arr
End Sub
1、假如你要排序的工百作表在sheet1，假如你的日期列在J，可以用以下代码： ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range("J3:J65535" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(1).Sort
.SetRange Range("A2:AL65535")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
2、后续如果有这度种常用功能的问VBA你可以选择录制宏，然后做一下，录制完看下VB编辑器的代码，稍作答修改即可得到你想要的代码。
3、你想要大一版点权的区域，只要将range的区域改大就可以了。
有些特殊排序要求，对于EXCEL标准功能是无法解决的。这时就可以用VBA来对应。例如：有一张原始数据表，如图：
根据此原始数据建立了一张分类汇总数据表，如图：
要求是，当明细表数据发生变更时，希望汇总表能自动排序。这样的要求，用手工排序就无法自动了。这样的要求只能依赖于VBA。首先编制一个排序的程序，代码如下：
Sub 排序()
Dim mYsheet As String
Dim arr(1 To 3, 1 To 2)
Dim I, J, K As Integer
Dim M_S1 As String '存放交换地区名
Dim M_S2 As Double '存放交换销售额
mYsheet = "汇总排名"
Sheets(mYsheet).Select
'将数值读取到数组中
For I = 1 To 3
For J = 1 To 2
arr(I, J) = Cells(I + 1, J + 1)
Next J
Next I
'排序
For I = 1 To 2
For J = I + 1 To 3
If arr(I, 2) < arr(J, 2) Then
M_S1 = arr(I, 1)
M_S2 = arr(I, 2)
arr(I, 1) = arr(J, 1)
arr(I, 2) = arr(J, 2)
arr(J, 1) = M_S1
arr(J, 2) = M_S2
End If
Next J
Next I
'将数组的排序结果7a64e59b9ee7ad94364存放到单元格中
For I = 1 To 3
Cells((I + 1), 2) = arr(I, 1)
Next I
End Sub
再编制一个单元格内容变更的事件触发程序，代码如下：（注：这个代码要放在原始数据表中）
Private Sub worksheet_change(ByVal target As Range)
If target.Column <= 4 Then
排序
End If
End Sub
假设你百的工作表名为“度表”，采知用如下代码道
Sub 排序()
With ActiveWorkbook.Worksheets("表版").Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A2"), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal '降序排列权
.SetRange Worksheets("表").Range("A2:C13")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
升序为Order:=xlAscending