Question

排序代码不再有效。它第一次工作。然后我关闭它并打开它然后它给了我一个错误。（我没有改变任何事情。）它给了我：

错误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

Answer 1

如果调试信息显示 FNOrder 变量已正确分配，则此缩短版本的排序代码应该是您需要的全部内容。

    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 已正确定义，则无需指定父工作簿。

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

如果崩溃，请检查VBE的立即窗口（例如Ctrl + G）以查看报告的内容是 FNOrder 的值。

如果您满意的话，我建议您将其发布到Code Review (Excel)以获取优化提示。

Answer 2

固定。我在所有对ActiveSheet的引用中更改了DataWB.DataSheet。谢谢你的帮助。

VBA排序宏不起作用

2 个答案: