Vba 无法使用范围对XLS数据进行排序。排序

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

我对宏非常陌生，一直在做这个小任务，以节省一些报告时间

以下是我尝试过的：

提示用户选择一个文件

将列从A设置为H

将范围排序为D2

保存文件

正如我所说，我是新手，我使用了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

没有什么对我有用。文件保持原样，不进行任何更新。我不明白，我在这里犯的新手错误是什么

请帮忙

参考资料：

---

它可能很简单，只需添加几个点（见下面的第二行）

---

SJR说您的引用应该在

With语句中完全限定是正确的

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

重构代码
看起来你忘了在
列
前面添加一个点，在
mybook.Sheets（SHEETNAME）
中。就是这样。那个人把它修好了。我记得我也这么做过，但没用。现在看看代码版本控制，我犯的错误是没有将
与
一起使用。谢谢SJR！这太棒了。谢谢你的返工。
IsWorkbookOpen（arExcelFiles（x））
抛出了一个编译器错误（错误的变量类型ref）。我修复了它，现在我的代码比以前更好了。干杯
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

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