使用vba代码进行自定义排序

对于下面的代码，我得到一个运行时错误'13'，当它到达下面的代码时，类型不匹配错误

ActiveWorkbook.Worksheets("3. PMO Internal View").Sort.SortFields.Add Key:= _
f, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal

上面的那段代码在下面的完整代码中，我把它放在了粗体中，它在代码的末尾

我试图做的是按当前状态列进行筛选（这很好），然后我希望它按第2列和第3列进行自定义排序（“PCR编号”和“帐户ID”）。如果我只使用原始记录的代码（范围（“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

的关键参数应具有范围或单元格地址。您的

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：

我想这就是你需要的（这次我测试了它）：

---

请注意，我总是使用

Sh

工作表来指定

范围

和

单元格

属性所指的工作表。这允许您使用此功能，而不考虑激活的图纸。使用

单元格（…）

或

范围（…）

而不指定工作表默认为活动工作表，并强制您在排序前激活要排序的工作表。

感谢您的回复。这里的问题是，如果F=A1，那么如果我在开头插入另一列，那么A1列将是B1列。我需要让它捕获列名，这样，如果第一列移动到第二列或超过第二列，它就不会在捕获列名时中断代码。请尝试使用

Set f=Cells（1，）

Hi-Stenci，如果我输入的是列号，如果列号发生变化怎么办。所以只要说我想捕获的列号是第1列，但我在开始处添加了另一列，所以原来的第1列是第2列。这不会破坏宏代码吗？我是否应该按列名捕获它？我用代码示例编辑了答案。我没有尝试，我希望它能起作用。嗨，谢谢你的反馈。不幸的是，我还是犯了同样的错误。这部分代码仍然存在类型不匹配错误。我是否应该在下面的代码段中添加f以外的其他内容？ActiveWorkbook.Worksheets（“3.PMO内部视图”）.Sort.SortFields.Add键：=\uf，SortOn:=xlSortOnValues，Order:=xlAscending，DataOption:=\uxlSortnormal

  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