Question

我正在尝试为特定工作表的表进行自定义排序，但是我得到运行时错误“483”“对象不支持此属性或方法”。

我将工作表名称和自定义列表顺序作为用户的字符串输入。

Option Explicit    
Sub SortRiskArea()

Dim wk As Worksheet
Dim Tb, Rb

Dim shtName As String
    shtName = InputBox(Prompt:="Enter the Worksheet Name that you want to sort." & vbNewLine & " Ex: Risk Register ", Title:="Hello", Default:="Risk Register")
    shtName = Trim(shtName)

Dim strName As String
    strName = InputBox(Prompt:="Enter the Sort Order for Risk Area" & vbNewLine & " Ex: Commercial, Technological, Management, Reputational, Governance, Operational", Title:="Hello", Default:="Commercial, Technological, Management, Reputational, Governance, Operational")
    strName = Replace(strName, " ", "")

Set wk = Sheets(shtName)

If shtName = "Risk Register" Then Tb = "Table1"
If shtName = "SAP BI" Then Tb = "Table13"
If shtName = "SAP BO" Then Tb = "Table14"
If shtName = "SAP BW" Then Tb = "Table15"
If shtName = "SAP PM" Then Tb = "Table16"
If shtName = "Mobility" Then Tb = "Table17"
If shtName = "SAP FI" Then Tb = "Table18"
If shtName = "SAP Service Desk" Then Tb = "Table19"

Rb = "[Risk Area]"
Rb = Tb & Rb

     Error Lines   > ActiveWorkbook.wk.ListObjects(Tb).Sort. _
                     SortFields.Add Key:=Range(Rb), SortOn:=xlSortOnValues, _
                     Order:=xlAscending, CustomOrder:= _
                     strName, _
                     DataOption:=xlSortNormal
    With ActiveWorkbook.wk.ListObjects(Tb).Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("B5").Select
End Sub

Answer 1

你的代码一直很不走运，因为大多数元素几乎都是正确的，但不幸的是，关键的元素缺少最后一点准确性。这是清单：

第ActiveWorkbook.wk.ListObjects(Tb).Sort行正在尝试访问不存在的ActiveWorkbook属性。 wk本身就是Sheet个对象，由于此行Set wk = Sheets(shtName)缺席ActiveWorkbook。所以这两行都应该是wk.ListObjects(Tb).Sort。更好的是，您还可以明确地设置wk：Set wk = ActiveWorkbook.Sheets(shtName)或Set wk = ThisWorkbook.Sheets(shtName)
由于您尚未明确设置，因此此行Key:=Range(Rb)采用ActiveSheet而非目标表。所以应该说Key:=wk.Range(Rb)
自定义排序顺序是棘手的野兽。我担心你的代码不会工作，即使你会觉得你几乎完全复制了自动生成的宏代码。它实际工作的方式是在CustomList对象中创建Application，然后使用Integer引用其索引。在下面的示例代码中，您将看到如何执行此操作，但您应该知道只有在您的自定义项为Strings时它才会起作用。
您的最后一行可能无法执行您想要的操作，因为Range("xx").Select会再次出现ActiveSheet，而您希望选择目标工作表。

其他一些更通用的编码点：

您应该明确声明每个变量。所以这一行Dim Tb, Rb并不是很好，因为每一行Variants只会增加不必要的处理时间，并且会使调试变得更加困难。
用户输入框询问了很多用户。他/她必须确保没有单个拼写错误或错误的工作表/自定义值条目，否则将发生未处理的错误。此任务非常适合Userform，其中您可以拥有一个ComboBox包含所有目标工作表名称，一个ListBox包含您的自定义订单商品。如果您将ComboBox ColumnCount更改为2，那么您也可以创建工作表名称 - 表名称映射。也许快速阅读Userforms以了解如何做到这一点;这真的很容易。
如果您创建了Sheet到ListObject的地图，则代码会更容易管理。你只需要这样做一次就可以在没有所有If语句的情况下多次运行你的程序。您还可以更好地控制任何更改和对象设置。

下面的代码显示了如何完成所有这些操作。这不是完美的编码，但它使每一点都没有过分分散注意力：

Sub SortRiskArea()
    Dim tableMapping As Collection
    Dim map(1) As Variant
    Dim sortItems As Variant
    Dim sortSheet As Worksheet
    Dim sortObject As ListObject
    Dim sortKey As Range
    Dim sortOrder As Integer
    Dim userInput As String

    'Create the map of sheets to tables
    'Note: you'd do this at module-level if there are repeated sorts.
    Set tableMapping = New Collection
    Set map(0) = ThisWorkbook.Sheets("Risk Register")
    Set map(1) = map(0).ListObjects("Table1")
    tableMapping.Add map, map(0).Name
    Set map(0) = ThisWorkbook.Sheets("SAP BI")
    Set map(1) = map(0).ListObjects("Table13")
    tableMapping.Add map, map(0).Name
    Set map(0) = ThisWorkbook.Sheets("SAP BO")
    Set map(1) = map(0).ListObjects("Table14")
    tableMapping.Add map, map(0).Name
    Set map(0) = ThisWorkbook.Sheets("SAP BW")
    Set map(1) = map(0).ListObjects("Table15")
    tableMapping.Add map, map(0).Name
    Set map(0) = ThisWorkbook.Sheets("SAP PM")
    Set map(1) = map(0).ListObjects("Table16")
    tableMapping.Add map, map(0).Name
    Set map(0) = ThisWorkbook.Sheets("Mobility")
    Set map(1) = map(0).ListObjects("Table17")
    tableMapping.Add map, map(0).Name
    Set map(0) = ThisWorkbook.Sheets("SAP FI")
    Set map(1) = map(0).ListObjects("Table18")
    tableMapping.Add map, map(0).Name
    Set map(0) = ThisWorkbook.Sheets("SAP Service Desk")
    Set map(1) = map(0).ListObjects("Table19")
    tableMapping.Add map, map(0).Name

    'Acquire the target sheet
    On Error Resume Next
    Do
        userInput = InputBox(Prompt:="Enter the Worksheet Name that you want to sort." & vbNewLine & " Ex: Risk Register ", Title:="Hello", Default:="Risk Register")
        sortItems = Empty
        sortItems = tableMapping(userInput)
        If IsEmpty(sortItems) Then MsgBox "Invalid entry."
    Loop Until Not IsEmpty(sortItems)
    On Error GoTo 0

    Set sortSheet = sortItems(0)
    Set sortObject = sortItems(1)
    Set sortKey = sortSheet.Range(sortObject.Name & "[Risk Area]")

    'Acquire the custom sort order
    userInput = InputBox(Prompt:="Enter the Sort Order for Risk Area" & vbNewLine & " Ex: Commercial, Technological, Management, Reputational, Governance, Operational", Title:="Hello", Default:="Commercial, Technological, Management, Reputational, Governance, Operational")
    userInput = Replace(userInput, " ", "")
    Application.AddCustomList Split(userInput, ",")
    sortOrder = Application.CustomListCount

    'Conduct the sort
    With sortObject.Sort
        .SortFields.Clear
        .SortFields.Add Key:=sortKey, SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=sortOrder, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    'Safe select "B5"
    sortSheet.Activate
    sortSheet.Range("B5").Select
End Sub

运行时错误“483”“对象不支持此属性或方法”

1 个答案: