Ошибка выполнения 91 при сортировке

Question

Я пишу подпрограмму, чтобы динамически копировать 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

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 

Очевидно, что это грубый, вам нужно будет сделать это самостоятельно, но это позволит вам отсортировать столбец E, который является тем, что ваш исходный код выглядит так, как он пытался это сделать.

Answer 2

Range.Sort method может использоваться для быстрой сортировки одного столбца и сбрасывает большую часть подробного кода, созданного при записи операции сортировки листа. Без активного 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 statement, используйте . отметить родительский лист и отбросить метод Range .Activate и ws переменной.

Answer 3

Замените ваш код ниже

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