VBA排序不起作用

时间:2015-07-30 10:23:08

标签: excel vba excel-vba sorting

我为用于某些计算的excel文件的宏创建了一个VBA代码。它需要逐个将两列excel表分类。它正在对第一列进行排序,但无法对另一列进行排序,尽管两者的代码完全相同,但列号除外。以下是该工作表计算的代码段:

Sheets("Restock Clusters").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False
LastRow = Range("B:C").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A" & LastRow)
Range("D3:F3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("D2:F2").Select
Selection.AutoFill Destination:=Range("D2:F" & LastRow)
Range("C1").Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Restock Clusters").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Restock Clusters").AutoFilter.Sort.SortFields.Add _
    Key:=Range("C:C"), SortOn:=xlSortOnValues, Order:=xlDescending, _
    DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Restock Clusters").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Range("A1").Select
Application.CutCopyMode = False
Selection.AutoFilter
Selection.AutoFilter
ActiveWorkbook.Worksheets("Restock Clusters").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Restock Clusters").AutoFilter.Sort.SortFields.Add _
    Key:=Range("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, _
    DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Restock Clusters").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
ActiveSheet.Calculate

1 个答案:

答案 0 :(得分:1)

Avoid使用.Select除了有时会导致运行时错误之外,它通常会降低代码速度。

这是你正在尝试的(未经测试)?

Sub Sample()
    Dim ws As Worksheet
    Dim Lastrow As Long

    Set ws = ThisWorkbook.Sheets("Restock Clusters")

    With ws
        '~~> Where is the copy code???

        .Range("B1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False

        Lastrow = .Range("B:C").Find("*", searchorder:=xlByRows, _
                  searchdirection:=xlPrevious).Row

        .Range("A3:A" & Lastrow).ClearContents

        .Range("A2:A" & Lastrow).Formula = .Range("A2").Formula

        .Range("D3:F" & Lastrow).ClearContents

        .Range("D2:F" & Lastrow).Formula = .Range("D2:F2").Formula

        '~~> Sort Col C
        .Columns(3).Sort Key1:=.Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

        '~~> Sort Col A
        .Columns(1).Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    End With
End Sub