Method apply of object sort failed

@mrf · Регистрация: 16.03.2012

Студворк — интернет-сервис помощи студентам

Добрый день,
год макрос работал идеально, но последние 3 три дня зависает. Смысл макроса: есть 3 листа. Сначала макрос фильтрует лист 1 по цвету и сравнивает его с 2м, потом фильтрует заново лист 1 по другому цвету и сравнивает его с 3м.
при открытии файла все работает. Но если удалить хоть 1ну строчку с листа 2 или 3, то зависает.

Если принудительно остановить, то пишет "method "apply" of object "sort" failed".
В чем причина? Как исправить?
вот код:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
Dim i As Long, j As Long, a(), b$, c$
    Dim tmp As Worksheet, rangeOne As Range, rangeTwo As Range
                 Application.EnableEvents = False
 
 Sheets("SHEEET1").Select
 Columns("A:AA").Select
    Selection.EntireColumn.Hidden = False
    Sheets("SHEEET2").Select
    Columns("A:AA").Select
    Selection.EntireColumn.Hidden = False
Sheets("SHEEET1").Select
        ActiveSheet.Range("$A$1:$AA$18999").AutoFilter Field:=1, Criteria1:=RGB(0, 176 _
        , 80), Operator:=xlFilterCellColor
        Sheets("SHEEET2").Select
            Columns("B:B").Select
    ActiveWorkbook.Worksheets("SHEEET2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("SHEEET2").Sort.SortFields.Add Key:=Range("B1"), SortOn _
        :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("SHEEET2").Sort
        .SetRange Range("A2:AB7777")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
            End With
Range("A1").Select
 
    Set rangeOne = Sheets("SHEEET1").UsedRange
    Set rangeTwo = Sheets("SHEEET2").UsedRange
    Set rangeOne = rangeOne.SpecialCells(xlCellTypeVisible)
    Set rangeTwo = rangeTwo.Offset(, 1).resize(, rangeTwo.Columns.Count - 1)
    Set tmp = Sheets.Add
    rangeOne.Copy
    tmp.Paste
    Set rangeOne = tmp.Cells(1).resize(rangeTwo.Rows.Count, rangeTwo.Columns.Count)
    b = rangeOne.Address(, , Application.ReferenceStyle, True)
    c = rangeTwo.Address(, , Application.ReferenceStyle, True)
    a = Evaluate(b & "<>" & c)
    Application.DisplayAlerts = False
    tmp.Delete
    Application.DisplayAlerts = True
    For i = 1 To UBound(a)
        For j = 1 To UBound(a, 2)
            If a(i, j) Then rangeTwo.Cells(i, j).Interior.Color = RGB(255, _
        0, 0)
        Next j
    Next i
       Sheets("SHEEET1").Select
   ActiveSheet.Range("$A$1:$AA$18999").AutoFilter Field:=1
          Sheets("SHEEET2").Select
        
              Sheets("SHEEET1").Select
    Columns("G:G").Select
    Selection.EntireColumn.Hidden = True
    Sheets("SHEEET2").Select
    Columns("H:H").Select
    Selection.EntireColumn.Hidden = True
     Columns("U:U").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:P").Select
    Selection.EntireColumn.Hidden = True
    Range("A1").Select
    Selection.Copy
    Range("B1:AA1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
                 Range("a2:a3").AutoFill Range("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row)
            Application.CutCopyMode = False
                      
'=====================================
                 Sheets("SHEEET1").Select
 Columns("A:AA").Select
    Selection.EntireColumn.Hidden = False
    Sheets("SHEEET3").Select
    Columns("A:AA").Select
    Selection.EntireColumn.Hidden = False
Sheets("SHEEET1").Select
        ActiveSheet.Range("$A$1:$AA$18999").AutoFilter Field:=1, Criteria1:=RGB(255, _
        0, 0), Operator:=xlFilterCellColor
        Sheets("SHEEET3").Select
            Columns("B:B").Select
    ActiveWorkbook.Worksheets("SHEEET3").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("SHEEET3").Sort.SortFields.Add Key:=Range("B1"), SortOn _
        :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("SHEEET3").Sort
        .SetRange Range("A2:AB699")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
            End With
Range("A1").Select
 
    Set rangeOne = Sheets("SHEEET1").UsedRange
    Set rangeTwo = Sheets("SHEEET3").UsedRange
    Set rangeOne = rangeOne.SpecialCells(xlCellTypeVisible)
    Set rangeTwo = rangeTwo.Offset(, 1).resize(, rangeTwo.Columns.Count - 1)
    Set tmp = Sheets.Add
    rangeOne.Copy
    tmp.Paste
    Set rangeOne = tmp.Cells(1).resize(rangeTwo.Rows.Count, rangeTwo.Columns.Count)
    b = rangeOne.Address(, , Application.ReferenceStyle, True)
    c = rangeTwo.Address(, , Application.ReferenceStyle, True)
    a = Evaluate(b & "<>" & c)
    Application.DisplayAlerts = False
    tmp.Delete
    Application.DisplayAlerts = True
    For i = 1 To UBound(a)
        For j = 1 To UBound(a, 2)
            If a(i, j) Then rangeTwo.Cells(i, j).Interior.Color = RGB(0, 176 _
        , 80)
        Next j
    Next i
 
       Sheets("SHEEET1").Select
   ActiveSheet.Range("$A$1:$AA$18999").AutoFilter Field:=1
          Sheets("SHEEET3").Select
       
              Sheets("SHEEET1").Select
    Columns("G:G").Select
    Selection.EntireColumn.Hidden = True
    Sheets("SHEEET3").Select
    Columns("H:H").Select
    Selection.EntireColumn.Hidden = True
    Columns("U:U").Select
    Selection.EntireColumn.Hidden = True
    Range("A1").Select
    Selection.Copy
    Range("B1:AA1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
                   Range("a2:a3").AutoFill Range("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row)
            Application.CutCopyMode = False
 '====================================================================

Добавлено через 21 минуту
Добавлю, все это произошло после апдейтов Оффиса (32-разрядная версия)

Добавлено через 2 часа 5 минут
удалил куски, которые глючат:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
ActiveWorkbook.Worksheets("SHEEET2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("SHEEET2").Sort.SortFields.Add Key:=Range("B1"), SortOn _
        :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("SHEEET2").Sort
        .SetRange Range("A2:AB7777")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
            End With

и появилась новая ошибка...: method "calculate" of object "_Worksheet" failed

Добавлено через 2 минуты
Вобщем или
"method "apply" of object "sort" failed"
или
"method "calculate" of object "_Worksheet" failed"

причем обе ошибки только тогда когда до запуска макроса удаляется одна (любая) строчка или с листа 1 или с листа 2...

Добавлено через 2 часа 57 минут
вернее при удалении любой строчки с любого листа (четвертого, пятого и т.п.)
но если стереть только данные из строчки (не удаляя ее саму), то все работает ...............................
короче, глюк после удаления любой строки на любом листе... Может тему переименовать соотвественно......?

@mrf · 02.06.2017, 17:19 **[ТС]**

вопрос снимаю, разобрался.

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Desktop (MinGW): Создаём пустое окно с нуля для 2D-графики на SDL3, Си и C++ 8Observer8 10.03.2026 Содержание блога Финальные проекты на Си и на C++: hello-sdl3-c. zip hello-sdl3-cpp. zip Результат:	Установка CMake и MinGW 13.1 для сборки С и C++ приложений из консоли и из Qt Creator в EXE 8Observer8 10.03.2026 Содержание блога MinGW - это коллекция инструментов для сборки приложений в EXE. CMake - это система сборки приложений. Здесь описаны базовые шаги для старта программирования с помощью CMake и. . .	Как дизайн сайта влияет на конверсию: 7 решений, которые реально повышают заявки Neotwalker 08.03.2026 Многие до сих пор воспринимают дизайн сайта как “красивую оболочку”. На практике всё иначе: дизайн напрямую влияет на то, оставит человек заявку или уйдёт через несколько секунд. Даже если у вас. . .	Модульная разработка через nuget packages DevAlt 07.03.2026 Сложившийся в . Net-среде способ разработки чаще всего предполагает монорепозиторий в котором находятся все исходники. При создании нового решения, мы просто добавляем нужные проекты и имеем. . .
Модульный подход на примере F# DevAlt 06.03.2026 В блоге дяди Боба наткнулся на такое определение: В этой книге («Подход, основанный на вариантах использования») Ивар утверждает, что архитектура программного обеспечения — это структуры,. . .	Управление камерой с помощью скрипта OrbitControls.js на Three.js: Вращение, зум и панорамирование 8Observer8 05.03.2026 Содержание блога Финальная демка в браузере работает на Desktop и мобильных браузерах. Итоговый код: orbit-controls-threejs-js. zip. Сканируйте QR-код на мобильном. Вращайте камеру одним пальцем,. . .	SDL3 для Web (WebAssembly): Синхронизация спрайтов SDL3 и тел Box2D 8Observer8 04.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-sync-physics-sprites-sdl3-c. zip На первой гифке отладочные линии отключены, а на второй включены:. . .	SDL3 для Web (WebAssembly): Идентификация объектов на Box2D v3 - использование userData и событий коллизий 8Observer8 02.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-collision-events-sdl3-c. zip Сканируйте QR-код на мобильном и вы увидите, что появится джойстик для управления главным героем. . . .

@mrf 12 / 12 / 4 Регистрация: 16.03.2012 Сообщений: 252
	02.06.2017, 17:19 [ТС]
	вопрос снимаю, разобрался. 0