无法使用Range.Sort对XLS数据进行排序

Question

我有一个xl文件，大约有2000行和A到H的列。我试图根据列D对文件进行排序，以便所有其他列也相应地进行排序（扩展选择区域）。

我是Macros的新手，并且一直在执行这项小任务，以节省我的报告时间。

这是我尝试的内容：

1. 提示用户选择文件
2. 将列从A设置为H
3. 将范围排序为D2
4. 保存文件

正如我所说，我是新手，我已经使用了MSDN库中示例示例中的大部分代码。除了Sort（）之外，其他任何东西都适合我。

这里是代码

Sub Select_File_Windows()
    Dim SaveDriveDir As String
    Dim MyPath As String
    Dim Fname As Variant
    Dim N As Long
    Dim FnameInLoop As String
    Dim mybook As Workbook
    Dim SHEETNAME As String

    'Default Sheet Name
    SHEETNAME = "Sheet1"

    ' Save the current directory.
    SaveDriveDir = CurDir

    ' Set the path to the folder that you want to open.
    MyPath = Application.DefaultFilePath

    ' Open GetOpenFilename with the file filters.
    Fname = Application.GetOpenFilename( _
            FileFilter:="XLS Files (*.xls),*.xls,XLSX Files (*.xlsx),*.xlsx", _
            Title:="Select a file", _
            MultiSelect:=True)

    ' Perform some action with the files you selected.
    If IsArray(Fname) Then
        With Application
            .ScreenUpdating = False
            .EnableEvents = True
        End With

        For N = LBound(Fname) To UBound(Fname)

            ' Get only the file name and test to see if it is open.
            FnameInLoop = Right(Fname(N), Len(Fname(N)) - InStrRev(Fname(N), Application.PathSeparator, , 1))
            If bIsBookOpen(FnameInLoop) = False Then

                Set mybook = Nothing
                On Error Resume Next
                Set mybook = Workbooks.Open(Fname(N))
                On Error GoTo 0

                DoEvents

                If Not mybook Is Nothing Then
                    Debug.Print "You opened this file : " & Fname(N) & vbNewLine

                    With mybook.Sheets(SHEETNAME)

                        'Columns("A:H").Sort Key1:=Range("D2:D2000"), Order1:=xlAscending, Header:=xlYes
                        'Range("A1:H2000").Sort Key1:=Range("D1"), Order1:=xlAscending
                        Columns("A:H").Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=xlYes

                    End With

                    Debug.Print "Sorter Called"

                    mybook.Close SaveChanges:=True
                End If
            Else
                Debug.Print "We skipped this file : " & Fname(N) & " because it is already open. Please close the data file and try again"
        End If
        Next N
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End If

End Sub


Function bIsBookOpen(ByRef szBookName As String) As Boolean
    On Error Resume Next
    bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

没有什么对我有用。该文件保持不变，并且未对其进行更新。我无法理解，我在这里犯的新手错误是什么？

请帮忙。

参考文献：

1. https://msdn.microsoft.com/en-us/library/office/ff840646(v=office.15).aspx

2. http://analysistabs.com/vba/sort-data-ascending-order-excel-example-macro-code/

3. Run time error 1004 when trying to sort data on three different values

Answer 1

可能就像添加几个点一样简单（见下面的倒数第二行）

With mybook.Sheets(SHEETNAME)
    'Columns("A:H").Sort Key1:=Range("D2:D2000"), Order1:=xlAscending, Header:=xlYes
       'Range("A1:H2000").Sort Key1:=Range("D1"), Order1:=xlAscending
       .Columns("A:H").Sort Key1:=.Range("D1"), Order1:=xlAscending, Header:=xlYes
End With

Answer 2

SJR说你的引用应该在With Statement内完全合格。

您应该通过将大块代码提取到单独的子例程中来简化子例程。子程序处理的任务越少，读取和调试就越容易。

重构代码

Sub Select_File_Windows()
    Const SHEETNAME As String = "Sheet1"
    Dim arExcelFiles
    Dim x As Long

    arExcelFiles = getExcelFileArray

    If UBound(arExcelFiles) = -1 Then
        Debug.Print "No Files Selected"
    Else
        ToggleEvents False
        For x = LBound(arExcelFiles) To UBound(arExcelFiles)
            If IsWorkbookOpen(arExcelFiles(x)) Then
                Debug.Print "File Skipped: "; arExcelFiles(x)
            Else
                Debug.Print "File Sorted: "; arExcelFiles(x)
                With Workbooks.Open(arExcelFiles(x))
                    With .Sheets(SHEETNAME)
                        .Columns("A:H").Sort Key1:=.Range("D1"), Order1:=xlAscending, Header:=xlYes
                    End With
                    .Close SaveChanges:=True
                End With
            End If

        Next

        ToggleEvents True
    End If

End Sub

Function IsWorkbookOpen(ByRef szBookName As String) As Boolean
    On Error Resume Next
    IsWorkbookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Function getExcelFileArray()
    Dim result
    result = Application.GetOpenFilename( _
             FileFilter:="Excel Workbooks, *.xls; *.xlsx", _
             Title:="Select a file", _
             MultiSelect:=True)

    If IsArray(result) Then
        getExcelFileArray = result
    Else
        getExcelFileArray = Array()
    End If
End Function

Sub ToggleEvents(EnableEvents As Boolean)
    With Application
        .ScreenUpdating = EnableEvents
        .Calculation = IIf(EnableEvents, xlCalculationAutomatic, xlCalculationManual)
        .EnableEvents = EnableEvents
    End With
End Sub