运行时错误91sorting时

我正在写一个子程序dynamic地从一个表格复制2列到另一个。 这些列长度可能会从一个报告更改为另一个报告。

这里是代码：

---

Sub getAnalystsCount() Dim rng As Range Dim dict As Object Set dict = CreateObject("scripting.dictionary") Dim varray As Variant, element As Variant Set ws = ThisWorkbook.Worksheets("ReportData") With ws Worksheets("ReportData").Activate Columns("E:E").Select ActiveWorkbook.Worksheets("ReportData").AutoFilter.Sort.SortFields.Clear ActiveWorkbook.Worksheets("ReportData").AutoFilter.Sort.SortFields.Add Key:= _ Range("E1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("ReportData").AutoFilter.Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With lastrow = .Range("A" & .Rows.Count).End(xlUp).Row '~~> Set First row firstrow = 2 '~~> Set your range Set rng = .Range("E" & firstrow & ":E" & lastrow) varray = rng.Value 'Generate unique list and count For Each element In varray If dict.Exists(element) Then dict.Item(element) = dict.Item(element) + 1 Else dict.Add element, 1 End If Next End With Set ws = ThisWorkbook.Worksheets("Analysts") With ws Worksheets("Analysts").Activate 'Paste report somewhere ws.Range("A3").Resize(dict.Count, 1).Value = _ WorksheetFunction.Transpose(dict.Keys) ws.Range("B3").Resize(dict.Count, 1).Value = _ WorksheetFunction.Transpose(dict.Items) ...... 

错误在这一行：

  ActiveWorkbook.Worksheets("ReportData").AutoFilter.Sort.SortFields.Clear 

Answer 1

replace你的下面的代码

 Columns("E:E").Select ActiveWorkbook.Worksheets("ReportData").AutoFilter.Sort.SortFields.Clear ActiveWorkbook.Worksheets("ReportData").AutoFilter.Sort.SortFields.Add Key:= _ Range("E1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("ReportData").AutoFilter.Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 

用下面的代码

 Columns("E:E").Select lastrow1 = .Range("E" & .Rows.Count).End(xlUp).Row ActiveWorkbook.Worksheets("ReportData").Sort.SortFields.Clear ActiveWorkbook.Worksheets("ReportData").Sort.SortFields.Add Key:=Range("E1") _ , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("ReportData").Sort .SetRange Range("E2:E" & lastrow1) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 

Answer 2

 startCell = Range("A1").Address endCell = Range("E100000").End(xlUp).Address ActiveWorkbook.Worksheets("ReportData").Sort.SortFields.Clear ActiveWorkbook.Worksheets("ReportData").Sort.SortFields.Add Key:=Range("E1"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortTextAsNumbers With ActiveWorkbook.Worksheets("ReportData").Sort .SetRange Range(startCell,endCell) .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 

显然这很粗糙，你需要自己做，但是它可以让你sortingE列，这是你最初的代码看起来像是试图做的。

Answer 3

Range.Sort方法可用于快速的一列sorting，并丢弃logging工作表sorting操作时产生的大量详细代码。 没有一个积极的AutoFilter ，这是更好的方法。

 Sub getAnalystsCount() Dim el As Long, ws As Worksheet Dim dict As Object Dim varray As Variant Set dict = CreateObject("scripting.dictionary") 'don't know what is in column E but this might be helpful 'dict.comparemode = vbTextCompare 'non-case-sensitive Set ws = ThisWorkbook.Worksheets("ReportData") With ws 'this is not necessary inside a With ... End With block 'Worksheets("ReportData").Activate With .Range("A1").CurrentRegion 'this quick code line is all you need .Cells.Sort Key1:=.Columns(5), Order1:=xlAscending, _ Orientation:=xlTopToBottom, Header:=xlYes 'resize to # of rows -1 × 1 column and shift 1 row down and over to column E With .Resize(.Rows.Count - 1, 1).Offset(1, 4) 'store the raw values varray = .Value2 End With End With End With 'done with the ReportData worksheet 'Generate unique list and count 'I prefer to work with LBound and UBound For el = LBound(varray, 1) To UBound(varray, 1) If dict.Exists(varray(el, 1)) Then dict.Item(varray(el, 1)) = dict.Item(varray(el, 1)) + 1 Else dict.Add Key:=varray(el, 1), Item:=1 End If Next el Set ws = ThisWorkbook.Worksheets("Analysts") With ws 'this is not necessary inside a With ... End With block 'Worksheets("Analysts").Activate 'might want to clear the destination cell contents first if there is something there if application.counta(.Range("A3:B3") = 2 then _ .Range("A3:B" & .Cells(Rows.Count, "B").End(xlUp).Row).ClearContents 'Paste report somewhere .Range("A3").Resize(dict.Count, 1).Value = _ WorksheetFunction.Transpose(dict.Keys) .Range("B3").Resize(dict.Count, 1).Value = _ WorksheetFunction.Transpose(dict.Items) End With 'done with the Analysts worksheet End Sub 

我更喜欢使用LBound和UBound函数来确定数组的范围。

当你在With … End With语句中时 ，使用. 注意父级工作表并丢弃Range .Activate方法和wsvariables。