对于下面这段代码，我收到运行时错误“13”，当它到达下面的代码时出现类型不匹配错误
ActiveWorkbook.Worksheets("3. PMO Internal View").Sort.SortFields.Add Key:= _
f, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
上面这段代码在下面的完整代码中，我把它放在粗体中，它是在代码的末尾。
我想要做的是按当前状态列筛选（工作正常），然后我希望它分别通过第2列和第3列进行自定义排序（“PCR No.”和“Accn.ID” ）。如果我只使用原始录制的代码（Range（“B2：B2000”），SortOn：= xlSortOnValues，Order：= xlAscending，DataOption：=）它会工作正常但我想确保宏不会破坏我在一开始就决定使用一个列，所以我试图让它按列名而不是列号进行自定义排序。
这里有任何帮助。
Sub CommercialView() ' ' CommercialView Macro '
' Dim wrkbk, sourceBk As Workbook Set sourceBk = Application.ActiveWorkbook 'Clear Filter for all Columns START With ActiveSheet If .AutoFilterMode Then If .FilterMode Then .ShowAllData End If Else If .FilterMode Then .ShowAllData End If End If End With 'Clear Filter from all Columns END
'Copy the required columns and add them to the destination spreadsheet START
Workbooks.Add
Set wrkbk = Application.ActiveWorkbook
sourceBk.Activate
wrkbk.Activate
sourceBk.Activate
Dim aCell1, aCell2, aCell3, aCell4, aCell5, aCell6, aCell7, aCell8, aCell9, aCell10, aCell11, aCell12 As Range
Dim strSearch1, strSearch2, strSearch3, strSearch4, strSearch5, strSearch6, strSearch7, strSearch8, strSearch9, strSearch10, strSearch11, strSearch12 As String
strSearch1 = "Change Request Description"
strSearch2 = "PCR No."
strSearch3 = "Accn. ID"
strSearch4 = "Current State"
strSearch5 = "Approved Date"
strSearch6 = "Project"
strSearch7 = "Planned Commencement Date"
strSearch8 = "Notes"
strSearch9 = "Total Price (IIA, DIA, Execution ($)"
strSearch10 = "Price Calculator Status"
strSearch11 = "OM Entry"
strSearch12 = "CVP Ref. No."
Set aCell1 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch1, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set aCell2 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch2, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set aCell3 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch3, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set aCell4 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch4, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set aCell5 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch5, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set aCell6 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch6, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set aCell7 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch7, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set aCell8 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch8, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set aCell9 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch9, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set aCell10 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch10, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set aCell11 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch11, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set aCell12 = Sheets("3. PMO Internal View").Rows(1).Find(What:=strSearch12, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'~~> Do the copying here
Sheets("3. PMO Internal View").Range(Sheets("3. PMO Internal View").Columns(aCell1.Column).Address & "," _
& Sheets("3. PMO Internal View").Columns(aCell2.Column).Address & "," _
& Sheets("3. PMO Internal View").Columns(aCell3.Column).Address & "," _
& Sheets("3. PMO Internal View").Columns(aCell4.Column).Address & "," _
& Sheets("3. PMO Internal View").Columns(aCell5.Column).Address & "," _
& Sheets("3. PMO Internal View").Columns(aCell6.Column).Address & "," _
& Sheets("3. PMO Internal View").Columns(aCell7.Column).Address & "," _
& Sheets("3. PMO Internal View").Columns(aCell8.Column).Address & "," _
& Sheets("3. PMO Internal View").Columns(aCell9.Column).Address & "," _
& Sheets("3. PMO Internal View").Columns(aCell10.Column).Address & "," _
& Sheets("3. PMO Internal View").Columns(aCell11.Column).Address & "," _
& Sheets("3. PMO Internal View").Columns(aCell12.Column).Address).Copy
'Range("A1,B1,C1,D1,E1,G1,H1,I1,R1,V1,W1,X1").EntireColumn.Select
'Selection.Copy
Range("A2").Select
wrkbk.Activate
ActiveSheet.Paste
Selection.AutoFilter
'Copy the required columns and add them to the destination spreadsheet END
'To remove data validation START
Cells.Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
'To remove data validation END
wrkbk.Activate
wrkbk.Sheets("Sheet1").Select
'Filter Column Price Calculator Status with those that Require Review from Pricing START
Dim p As Integer, rngData As Range
Set rngData = Range("A1").CurrentRegion
p = Application.WorksheetFunction.Match("Price Calculator Status", Range("A1:AZ1"), 0)
rngData.AutoFilter Field:=p, Criteria1:="=Completed - Requires Review from Pricing"
'Filter Column Price Calculator Status with those that Require Review from Pricing END
'Copy the Status Definitions tab to the new worksheet START
sourceBk.Sheets("2. Status Definitions").Copy _
after:=ActiveWorkbook.Sheets("Sheet1")
'Copy the Status Definitions tab to the new worksheet END
wrkbk.Sheets("Sheet1").Select
Range("A5").Select
'Save to Desktop Directory as DOD folder name - Compatible for any user who runs the macro START
Dim uName As String: uName = Environ("Username")
fpath1 = "C:\Users\" & uName & "\Desktop\DOD"
fpath2 = "C:\Users\" & uName & "\Desktop\DOD\Change Status Request Report"
fpath3 = "C:\Users\" & uName & "\Desktop\DOD\Change Status Request Report\Commercial View"
If Dir(fpath1, vbDirectory) = vbNullString Then MkDir fpath1
If Dir(fpath2, vbDirectory) = vbNullString Then MkDir fpath2
If Dir(fpath3, vbDirectory) = vbNullString Then MkDir fpath3
ActiveWorkbook.SaveAs (fpath3 & "\Internal Change Status Request Report - Commercial View - " & Format(Now, "yyyy-mm-dd"))
ActiveWorkbook.Close
'Save to Desktop Directory as DOD folder name - Compatible for any user who runs the macro END
'Return back to Overall CR Tracker and filter out Approved and Cancelled CRs START
Dim s, f, g As Integer, rngData2, rngData5, rngData6 As Range
Set rngData2 = Range("A1").CurrentRegion
s = Application.WorksheetFunction.Match("Current State", Range("A1:AZ1"), 0)
rngData2.AutoFilter Field:=s, Criteria1:=Array( _
"Detailed Impact Assessment", "Draft – Yet to be Tabled at CCCM", _
"Initial Impact Assessment", "New", "On Hold", "Pending Approval - Execution", _
"Pending Approval - IIA"), Operator:=xlFilterValues
Set rngData5 = Range("B1").CurrentRegion
f = Application.WorksheetFunction.Match("PCR No.", Range("A1:AZ1"), 0)
Set rngData6 = Range("C1").CurrentRegion
g = Application.WorksheetFunction.Match("Accn. ID", Range("A1:AZ1"), 0)
ActiveWorkbook.Worksheets("3. PMO Internal View").Sort.SortFields.Clear
**ActiveWorkbook.Worksheets("3. PMO Internal View").Sort.SortFields.Add Key:= _
f, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal**
ActiveWorkbook.Worksheets("3. PMO Internal View").Sort.SortFields.Add Key:= _
g, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("3. PMO Internal View").Sort
.SetRange Range("A1:X2000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Return back to Overall CR Tracker and filter out Approved and Cancelled CRs END
End Sub
答案 0 :(得分：0)
Sort的Key参数应具有范围或单元格地址。您的f定义为f = Application.WorksheetFunction.Match()，返回一个数字。
您应该拥有Set f = Range("A1")或f = "A1"之类的内容。 Excel将使用包含指定单元格的列。
编辑1：
而不是：
f = Application.WorksheetFunction.Match("PCR No.", Range("A1:AZ1"), 0)
ActiveWorkbook.Worksheets("3. PMO Internal View").Sort.SortFields.Add Key:= f
您应该使用：
f = Application.WorksheetFunction.Match("PCR No.", Range("A1:AZ1"), 0)
ActiveWorkbook.Worksheets("3. PMO Internal View").Sort.SortFields.Add Key:= Cells(1, f)
考虑到您的代码时会想到其他一些评论：
您的变量声明不符合您的想法：
Dim s, f, g As Integer, rngData2, rngData5, rngData6 As Range
'is equivalent to
Dim s As Variant, f As Variant, g As Integer, rngData2 As Variant, rngData5 As Variant, rngData6 As Range
'you should write
Dim s As Integer, f As Integer, g As Integer, rngData2 As Range, rngData5 As Range, rngData6 As Range
您粘贴了太多代码。当我看到它时，我只是浏览了它，我很幸运，我看到了问题。我通常会跳过这样的问题。您应该尝试编写尽可能短的函数来重现相同的问题。这有助于您解决两个问题：有人会更有可能阅读它并为您提供解决方案，而且您更有可能在减少问题的过程中自行解决问题。我经常在这里开始写问题，但我不发布它们，因为只是想着如何写它以便你能理解它，让我理解它。
标记答案，以帮助您作为答案。我注意到你从来没有这样做，许多人喜欢帮助别人换取那个令人满意的复选标记。如果你是那个不满足的人，人们就不会帮助你。
编辑2：
我认为这就是你所需要的（这次是我测试过的）：
Dim f As Integer, g As Integer, Sh As Worksheet
Set Sh = Sheets("3. PMO Internal View")
f = WorksheetFunction.Match("PCR No.", Sh.Range("A1:AZ1"), 0)
g = WorksheetFunction.Match("Accn. ID", Sh.Range("A1:AZ1"), 0)
Sh.Range("A1:X2000").Sort Key1:=Sh.Cells(1, f), Order1:=xlAscending, Key2:=Sh.Cells(1, g), Order2:=xlAscending
请注意，我始终使用Sh工作表来指定Range和Cells属性所引用的工作表。这使您可以使用此功能，无论活动工作表如何。使用Cells(...)或Range(...)而不指定工作表默认为活动工作表，并强制您在排序之前激活要排序的工作表。