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

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

我对macros很新，并且一直在做这个小任务来节省我的报告时间。

这是我的尝试：

1. 提示用户select一个文件
2. 将列从A设置为H
3. 将范围sorting为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. 尝试在三个不同的值上对数据进行sorting时，运行时错误1004

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 。

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

重构代码

 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