VBAsortingmacros不工作

sorting代码不再工作。 这是第一次。 然后,我closures它,打开它,然后它给了我一个错误。 (我没有改变任何东西。)它给了我:

错误438:对象不支持此属性或方法

在这一行上:

DataWB.DataSheet.Sort.SortFields.Add Key:=Range(FNOrdCol), SortOn:=xlSortOnValues, _ Order:=xlAscending, DataOption:=xlSortNormal` 

代码片段:

  'Alpahebtical order DataSheet.Range("A1").Select ActiveCell.Rows("1:1").EntireRow.Select Selection.Find(What:=FNOrder, After:=ActiveCell, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate FNOrdCol = ActiveCell.Address DataWB.DataSheet.Sort.SortFields.Clear DataWB.DataSheet.Sort.SortFields.Add Key:=Range(FNOrdCol), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With DataWB.DataSheet.Sort .SetRange DataSheet.Cells .header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 

整个代码:

 Sub iGetData() Dim ValidatorWB As Workbook Dim PopDetail As Worksheet Dim DataSheetName As String Dim DataWB As Workbook Dim DataSheet As Worksheet Dim Ret Dim DWBName As String Dim FNOrder As String Dim FNOrdCol As String Set PopDetail = Worksheets("PopulateWireframe") Set ValidatorWB = Workbooks(ActiveWorkbook.Name) DataSheetName = Range("F18").Value FNOrder = Range("F33").Value Application.ScreenUpdating = False 'Open data file Ret = IsWorkBookOpen(PopDetail.Range("C18").Value) If Ret = False Then Workbooks.Open PopDetail.Range("C18").Value DataFileName = ActiveWorkbook.Name Set DataWB = Workbooks(DataFileName) Set DataSheet = Worksheets(DataSheetName) Dim FilterColumn As String Dim FilterCriteria As String Dim ColumnNumber As Integer 'Set filter With DataSheet If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then ActiveSheet.ShowAllData End If End With ValidatorWB.Activate PopDetail.Activate For x = 21 To 30 If Range("E" & x).Value <> "" And Range("F" & x).Value <> "" Then FilterColumn = PopDetail.Range("E" & x).Value FilterCriteria = PopDetail.Range("F" & x).Value DataWB.Activate DataSheet.Activate DataSheet.Range("A1").Select Selection.End(xlToLeft).Select ActiveCell.Rows("1:1").EntireRow.Select Selection.Find(What:=FilterColumn, After:=ActiveCell, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ColumnNumber = ActiveCell.Column DataSheet.AutoFilterMode = False DataSheet.Range("A1").AutoFilter Field:=ColumnNumber, Criteria1:=FilterCriteria End If ValidatorWB.Activate PopDetail.Activate 'x = x + 1 Next x DataWB.Activate DataSheet.Activate 'Alpahebtical order DataSheet.Range("A1").Select ActiveCell.Rows("1:1").EntireRow.Select Selection.Find(What:=FNOrder, After:=ActiveCell, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate FNOrdCol = ActiveCell.Address DataWB.DataSheet.Sort.SortFields.Clear DataWB.DataSheet.Sort.SortFields.Add Key:=Range(FNOrdCol), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With DataWB.DataSheet.Sort .SetRange DataSheet.Cells .header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'Copy data Range("A1").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy 'Paste data to validator ValidatorWB.Activate ValidatorWB.Sheets.Add().Name = "ValidatorData" ActiveCell.Offset(3, 0).Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True ActiveCell.Columns("A:A").EntireColumn.ColumnWidth = 15 Application.CutCopyMode = False 'DataWB.Close savechanges:=False If DataWB.Windows(1).Visible = True Then DataWB.Windows(1).Visible = False End If Application.ScreenUpdating = True PopDetail.Activate Else DWBName = GetFilenameFromPath(PopDetail.Range("C18").Value) Set DataWB = Workbooks(DWBName) DataWB.Activate Set DataSheet = Worksheets(DataSheetName) DataSheet.Activate With DataSheet If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then ActiveSheet.ShowAllData End If End With ValidatorWB.Activate PopDetail.Activate For x = 21 To 30 If Range("E" & x).Value <> "" And Range("F" & x).Value <> "" Then FilterColumn = PopDetail.Range("E" & x).Value FilterCriteria = PopDetail.Range("F" & x).Value DataWB.Activate DataSheet.Activate DataSheet.Range("A1").Select Selection.End(xlToLeft).Select ActiveCell.Rows("1:1").EntireRow.Select Selection.Find(What:=FilterColumn, After:=ActiveCell, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ColumnNumber = ActiveCell.Column DataSheet.AutoFilterMode = False DataSheet.Range("A1").AutoFilter Field:=ColumnNumber, Criteria1:=FilterCriteria End If ValidatorWB.Activate PopDetail.Activate 'x = x + 1 Next x DataWB.Activate DataSheet.Activate 'Alpahebtical order DataSheet.Range("A1").Select ActiveCell.Rows("1:1").EntireRow.Select Selection.Find(What:=FNOrder, After:=ActiveCell, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate FNOrdCol = ActiveCell.Address 'DataWB.DataSheet.Sort.SortFields.Clear DataWB.DataSheet.Sort.SortFields.Add Key:=Range(FNOrdCol), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With DataWB.DataSheet.Sort .SetRange DataSheet.Cells .header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'Copy data Range("A1").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy 'Paste data to validator ValidatorWB.Activate ValidatorWB.Sheets.Add().Name = "ValidatorData" ActiveCell.Offset(3, 0).Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True ActiveCell.Columns("A:A").EntireColumn.ColumnWidth = 15 Application.CutCopyMode = False 'DataWB.Close savechanges:=False If DataWB.Windows(1).Visible = True Then DataWB.Windows(1).Visible = False End If Application.ScreenUpdating = True PopDetail.Activate End If End Sub 

如果debugging信息显示FNOrdervariables是正确分配的,那么这个缩短版本的sorting代码应该是你所需要的。

  debug.print FNOrder & " is the name of the column to be sorted on" With DataSheet With .Cells(1, 1).CurrentRegion .Cells.Sort Key1:=.Columns(Application.Match(FNOrder, .Rows(1), 0)), Order1:=xlAscending, _ Orientation:=xlTopToBottom, Header:=xlYes .Cells.Copy End With End With 

如果DataSheet已被正确定义,则不需要指定父工作簿。

在代码部分的末尾,数据应该被sorting并且“在剪贴板上”。 您仍然需要将新工作表添加到ValidatorWB工作簿并粘贴值。

如果崩溃,请检查VBE的立即窗口(例如Ctrl + G),看看报告的是FNOrder的值。

如果你得到满意的结果,我会build议在Code Review(Excel)中发布优化提示。

固定。 我将所有引用中的DataWB.DataSheet都改为了ActiveSheet。 感谢您的帮助。