Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 27.04.2017, 09:20   #1
mr-111
Пользователь
 
Регистрация: 01.03.2012
Сообщений: 11
По умолчанию Method apply of object sort failed - VBA

Здравствуйте,
год макрос работал идеально, но последние несколько дней зависает. Смысл макроса: есть 3 листа. Сначала макрос фильтрует лист 1 по цвету и сравнивает его с 2м, потом фильтрует заново лист 1 по другому цвету и сравнивает его с 3м.
при открытии файла все работает. Но если удалить хоть 1ну строчку любого листа - зависает.
Если принудительно остановить, то пишет "method "apply" of object "sort" failed".
Добавлю, все это произошло после апдейтов Оффиса (32-разрядная версия).
удалил кусок, который глючит:
Код:
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"
В чем причина? Как исправить?

вот сам макрос:
Код:
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
_____
Код программы нужно выделять (форматировать) тегами [CODE] (читать FAQ)
Модератор

Последний раз редактировалось Serge_Bliznykov; 27.04.2017 в 09:35.
mr-111 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Python. генератор списка, ошибка - Failed test #1. Runtime error, TypeError: object of type 'generator' has no len() Young_programmer Python 7 13.02.2017 22:41
ошибка Run-time error - 217417848 (80010108): Method resize of object ListObject failed. Как исправить?!! andreptobts Microsoft Office Excel 0 11.01.2016 16:31
Run-time error 1004: Method Range of object Global failed failed sa920 Microsoft Office Excel 8 01.07.2012 22:40
Немецкая база. Ошибка "Method form of object _subform failed" budda999 Microsoft Office Access 5 20.06.2012 12:04
Runtime Error '1004': Range of Object '_Global' Failed panuta Microsoft Office Excel 6 17.05.2010 17:04