Excel это не сложно
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?
04.08.2020, 22:22:47

Войти
Название темы должно отражать её содержание.
Темы типа "ПОМОГИТЕ!!!", "Срочно!", "Не получается сделать", "Нужна помощь" и т.п. будут удаляться без объяснения причин
31 347 Сообщений в 5 019 Тем от 9 635 Пользователей
Последний пользователь: Томас
*
Перейти на сайт Хитрости Надстройка MulTEx Обучающие тренинги Наша группа ВКонтакте
Правила форума Начало Помощь Поиск Календарь Войти Регистрация Выйти
+  Excel это не сложно
|-+  Основные форумы
| |-+  Вопросы по Excel и VBA
| | |-+  Макрос не сортирует (вылетает) после перехода с офиса 2013 на 2016
Страниц: [1]   Вниз
Печать
Автор Тема: Макрос не сортирует (вылетает) после перехода с офиса 2013 на 2016  (Прочитано 728 раз)
0 Пользователей и 1 Гость смотрят эту тему.
ABSh
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 5


Просмотр профиля
« : 15.01.2020, 12:19:40 »

Здравствуйте уважаемые форумчане!
Прошу помощи в правке макроса. Сам имею зачаточные знания ВБА, поэтому в основном записываю небольшие макросы через встроенный макрорекордер, могу слегка подкорректировать Грустный
Смысл макроса простой - приводит открытый файл в нужный вид, удаляя некоторые столбцы, вытаскивает из эталонного файла значения для сравнения, сортирует выделенное по дате/времени и копирует в новый файл.
После смены компьютера и перехода на офис 2016 макрос стал вылетать на этапе сортировки (строка подсвечена красным).

Код: (vb)
Sub withError()
'
' withError Макрос
'

'
    Columns("B:C").Select
    Selection.Delete Shift:=xlToLeft
    Columns("C:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:M").Select
    Selection.Delete Shift:=xlToLeft
    Columns("F:F").Select
    Selection.Cut
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    
    Range("G11").Select
    ActiveCell.FormulaR1C1 = "=ROUND((RC[-6]*1)&(RC[-5]*1),7)"
    Range("H11").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC7,'C:\[Медиаскоп текущий.xlsx]Лист1'!C1:C29,2,0)"
    Range("I11").Select
    Selection.NumberFormat = "[h]:mm:ss;@"
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC7,'C:\[Медиаскоп текущий.xlsx]Лист1'!C1:C29,9,0)"
    Range("J11").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC7,'C:\[Медиаскоп текущий.xlsx]Лист1'!C1:C29,11,0)"
    
    lr = Cells(Rows.Count, 2).End(xlUp).Row
    Range("G11:J11").AutoFill Destination:=Range("G11:J" & lr), Type:=xlFillDefault
    Range("E11").Select
    Selection.NumberFormat = "General"
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[5]=""Ролик"",""Ролик"",IF(RC[5]=""Спонсорская заставка"",""Спонсорская заставка"",IF(RC[5]=""Анонс: спонсорская заставка"",""Спонсорская заставка"",""Спонсор показа"")))"
    Range("E11").AutoFill Destination:=Range("E11:E" & lr), Type:=xlFillDefault
    
    
    Range("A11:F" & lr).Select
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear      
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("A11:A" & lr), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("B11:B" & lr), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range("A10:F" & lr)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    
    Selection.Copy
    Workbooks.Open Filename:="C:\Рыба1.xlsx"
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    ler = Cells(Rows.Count, 2).End(xlUp).Row
    lep = Cells(Rows.Count, 1).End(xlUp).Row
    Rows((ler + 1) & ":" & lep).Select
    Selection.Delete Shift:=xlUp
    Range("A1:G" & (ler + 2)).Select
    
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=ЕОШИБКА(A1)"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False

End Sub

Комментарий администратора Коды оформляйте тегами VBCode. п.п. 4.25 Правил форума
« Последнее редактирование: 15.01.2020, 13:38:21 от Дмитрий Щербаков(The_Prist) » Записан
ABSh
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 5


Просмотр профиля
« Ответ #1 : 15.01.2020, 13:14:59 »

Забыл добавить - ошибка следующая:

Run-tine error '9':
Subscript out of range
Записан
Дмитрий Щербаков(The_Prist)
Администратор
Ветеран
*****

Репутация: +444/-0
Офлайн Офлайн

Сообщений: 5 269



Просмотр профиля WWW
« Ответ #2 : 15.01.2020, 13:46:53 »

Файл приложите с данными. Не уверен, но может где-то в самом коде ошибка при определенных данных, которую 2013 "проглатывал", а 2016 отказывается. Но это не точно.
Записан

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Пункты приёма Спасибов:    -41001332272872  -R298726502453
ABSh
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 5


Просмотр профиля
« Ответ #3 : 15.01.2020, 14:22:45 »

Прилагаю файл примера и эталонный
Записан
boa
Постоялец
***

Репутация: +20/-0
Офлайн Офлайн

Сообщений: 221


Доброта спасет мир...


Просмотр профиля WWW
« Ответ #4 : 15.01.2020, 16:03:13 »

После очередного обновления MSO у меня был глюк, когда Excel не понимал ActiveSheet
Я его обошел следующей конструкцией
вместо
Код: (vb)
ActiveWorkbook.ActiveSheet
напишите
Код: (vb)
Application.ActiveCell.Parent

Должно помочь.
У меня сейчас работают обе конструкции, но глюк имел место...

И еще, не используйте Селекты без надобности
строки
Код: (vb)
    Columns("B:C").Select
    Selection.Delete Shift:=xlToLeft

можно смело заменить на
Код: (vb)
Columns("B:C").Delete Shift:=xlToLeft
Записан

Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

ABSh
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 5


Просмотр профиля
« Ответ #5 : 15.01.2020, 16:58:22 »

Увы, не помогло  Грустный
А большое количество Селектов остались от макрорекордера. В связи с неглубокими познаниями предпочитаю сильно не трогать то, что работает...
Записан
Дмитрий Щербаков(The_Prist)
Администратор
Ветеран
*****

Репутация: +444/-0
Офлайн Офлайн

Сообщений: 5 269



Просмотр профиля WWW
« Ответ #6 : 15.01.2020, 17:30:09 »

Попробуйте добавить перед проблемной строкой такое:
Код: (vb)
Dim ws as worksheet
set ws = activecell.worksheet
'а это уже Ваш код с небольшими правками, учитывающими строки выше
ws.Sort.SortFields.Clear       
    ws.Sort.SortFields.Add Key:=Range("A11:A" & lr), _ 
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ 
        xlSortTextAsNumbers 
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("B11:B" & lr), _ 
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ 
        xlSortTextAsNumbers 
    With ws.Sort 
        .SetRange Range("A10:F" & lr) 
        .Header = xlYes 
        .MatchCase = False 
        .Orientation = xlTopToBottom 
        .SortMethod = xlPinYin 
        .Apply 
    End With
Записан

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Пункты приёма Спасибов:    -41001332272872  -R298726502453
ABSh
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 5


Просмотр профиля
« Ответ #7 : 15.01.2020, 18:18:39 »

Дмитрий, ОГРОМНОЕ СПАСИБО!
Заработало!!! Естественно, после замены еще одного куска кода на переменную ws  Подмигивающий
Если не сложно, поясните с чем эта проблема может быть связана? С элементами ActiveX?
Записан
Дмитрий Щербаков(The_Prist)
Администратор
Ветеран
*****

Репутация: +444/-0
Офлайн Офлайн

Сообщений: 5 269



Просмотр профиля WWW
« Ответ #8 : 15.01.2020, 19:06:43 »

Нет, с определением объектов вроде ActiveSheet при обращении из кода. Это проблема была озвучена, для её правки выпускался fix, но ссылку сейчас дать не могу - лень искать Улыбка
Кстати, настоятельно рекомендую ознакомиться: Select и Activate - зачем нужны и нужны ли?
В будущем может избавить от кучи проблем.
И элементы типа ActiveX я бы тоже настоятельно рекомендовал не использовать. Проблемы с ним были и весьма неприятные. Вот описание одной из них: Элементы ActiveX перестали работать или ведут себя непредсказуемо
« Последнее редактирование: 15.01.2020, 19:08:29 от Дмитрий Щербаков(The_Prist) » Записан

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Пункты приёма Спасибов:    -41001332272872  -R298726502453
Страниц: [1]   Вверх
Печать
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2011, Simple Machines Valid XHTML 1.0! Valid CSS!
Яндекс.Метрика Рейтинг@Mail.ru