求写一段VBA代码，在 Excel 兑现自动排序

2013-01-05

求写一段VBA代码，在 Excel 实现自动排序我想实现【刊物版面管理Excel表】[imghttp://www.5696.net/a/刊物版

求写一段VBA代码，在 Excel 实现自动排序
我想实现【刊物版面管理Excel表】[img=http://www.5696.net/a/刊物版面排序.xls][/img]中，自动排序的功能。
  即：A列、B列、C列的数据有变化时，按照首选A列（主要关键字）、B列（次要关键字）、C列（再次关键字）自动排序。
  为此，
  1、我写了 worksheet_change 事件触发代码：

Private Sub Worksheet_Change(ByVal Target As Range)

Dim h As Range

'If Target.Count > 1 Then End        '若同时改变多个单元格时，不想让其排序，请把本行首的“ ' ”去掉

If Target.Column < 4 And Target.Row > 3 Then     '若改变的单元格的列标小于４，行标大于2，（ＡＢＣ列）则运行下面语句

Set h = Range(Cells(Target.Row, 1), Cells(Target.Row, 36))     '让对象变量h为改变的单元格所在行的1—7列的内容

If Application.CountA(h) = 4 Then Call paixu            '如果 h 的所有单元格都有内容，则运行paixu程序

End If

End Sub

2、并在VBA工程中插入一模块，输入以下代码

Sub paixu()
'
' paixu Macro
'
' 快捷键: Ctrl+Shift+P
'
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    ActiveWindow.LargeScroll ToRight:=-2
    Range("A3:AM438").Select
    ActiveWindow.LargeScroll ToRight:=-2
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A3:A438") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B3:B438") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("C3:C438") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A3:AM438")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

但是，就是实现不了我需要的功能。

VBA实在太深奥了，我学了一个月没有闹明白。恳请高手指点

[解决办法]


'范围（用于监视数据变化的单元格的范围）
Const AMBIT_ROW_NO_START As Long = 3
Const AMBIT_ROW_NO_END As Long = 13
Const AMBIT_COL_NO_START As Long = 2
Const AMBIT_COL_NO_END As Long = 4
'用于排序的列的单元格地址（假设数据的起始行为第3行，要排序的列是B列、C列和D列）
Const SORT_KEY1_CELL As String = "B3"
Const SORT_KEY2_CELL As String = "C3"
Const SORT_KEY3_CELL As String = "D3"

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Row >= AMBIT_ROW_NO_START And Target.Row <= AMBIT_ROW_NO_END And _ 
 
        Target.Column >= AMBIT_COL_NO_START And Target.Column <= AMBIT_COL_NO_END Then
        SortData
    End If
    
End Sub

Private Sub SortData()
    
    Range(Cells(AMBIT_ROW_NO_START, AMBIT_COL_NO_START), Cells(AMBIT_ROW_NO_END, AMBIT_COL_NO_END)).Select
    Selection.Sort Key1:=Range(SORT_KEY1_CELL), Order1:=xlAscending, Key2:=Range(SORT_KEY2_CELL) _
        , Order2:=xlAscending, Key3:=Range(SORT_KEY3_CELL), Order3:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        SortMethod:=xlPinYin, DataOption1:=xlSortNormal, DataOption2:= _
        xlSortNormal, DataOption3:=xlSortNormal
    
End Sub

[解决办法]
你的paixu函数写的有问题
用这个吧

Sub paixu()
    Range("A3:AM438").Select
    Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Key2:=Range("B3") _
        , Order2:=xlAscending, Key3:=Range("C3"), Order3:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        SortMethod:=xlPinYin, DataOption1:=xlSortNormal, DataOption2:= _
        xlSortNormal, DataOption3:=xlSortNormal
End Sub

热点排行