VBA AZ排序无法正常工作

时间:2017-01-13 09:15:11

标签: excel vba excel-vba sorting

我希望你能提供帮助。 我有一段代码打开一个对话框,然后允许用户选择另一个Excel工作表然后一旦选择了Excel工作表,则调用另一段代码并按字母顺序对B列进行排序。

我遇到的问题是VBA代码没有正确排序

如果我通过点击AZ排序按钮手动对列进行排序,我会得到Pic 1中的结果

PIC 1

enter image description here

但是当我运行代码按字母顺序对B列进行排序时。我在Pic 2中得到了结果

PIC 2 enter image description here

正如您所看到的,顶部条目不正确,Anne Mette Toftager 没有正确排序,第二个条目仍位于第83行的工作表中

我的代码如下。可以修改我的代码以使排序正常工作,结果与图1中的结果相同吗?

一如既往,我们非常感谢任何帮助。

PS我应该指出VBA排序还必须'扩展选择'

我的代码

Sub Open_Workbook_Dialog()

Dim my_FileName As Variant

    MsgBox "Select Denmark File" '<--| txt box for prompt to pick a file

        my_FileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*") '<--| Opens the file window to allow selection

    If my_FileName <> False Then
    Workbooks.Open Filename:=my_FileName


Call SortColumn     '<--|Calls the Filter Code and executes

End If


End Sub

Public Sub SortColumn()
    With ActiveWorkbook.Sheets(1)

    .Unprotect
    lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    .Range("A1").Resize(79, lastcol).Sort Key1:=Range("B1"), _
    Order1:=xlAscending, _
    Header:=xlGuess, _
    OrderCustom:=1, _
    MatchCase:=False, _
    Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
End With
End Sub

1 个答案:

答案 0 :(得分:2)

这应该有效

Sub SortColumn()

    With ActiveWorkbook.Sheets(1)

        Dim LastRow As Long
        LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        Dim LastCol As Long
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        With ActiveWorkbook.Worksheets("Sheet1").Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range(Cells(2, 2), Cells(LastRow, 2)), _
                            SortOn:=xlSortOnValues, _
                            Order:=xlAscending, _
                            DataOption:=xlSortNormal
            .SetRange Range(Cells(2, 1), Cells(LastRow, LastCol))
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply

        End With

    End With
End Sub