Здравствуйте! Прошу что-либо подсказать по следующему вопросу. С Экселем, а тем более с макросами, я на "ВЫ И ШЕПОТОМ", но благодаря неоднократным подсказкам форумчан вымучил для себя рабочую книгу для определенных расчетов, вес которой составил примерно 2Мб. Прочитав тему "Файл распух до нелогичных размеров" воспользовался находящимися в ней кодами для уменьшения веса своей книги. Макрос выдал ошибку 1004 с сообщением "Программный доступ к проекту Visual Basic не является доверенным" и выделил строку в макросе "With wb.VBProject.VBComponents" при этом создав копию моей книги (правда без макросов , выпадающих списков), но сохранив все данные и размером всего 917Кб! Скопировав в новую книгу свой макрос получилось 943Кб! Отлично! НО как только я его запустил вес файла стал 1,65 Мб...,т.е все вернулось на свое место. При этом книга не связана с другими, данные из вне макрос не добавляет, работа его связана с извлечением данных по условию с одного листа на другой и пересчетом некоторых формул. Подскажите можно ли в принципе решить данную проблему - ну ооочень хочется! Файл большой - приложить не получается. Спасибо!
Здравствуйте! Прошу что-либо подсказать по следующему вопросу. С Экселем, а тем более с макросами, я на "ВЫ И ШЕПОТОМ", но благодаря неоднократным подсказкам форумчан вымучил для себя рабочую книгу для определенных расчетов, вес которой составил примерно 2Мб. Прочитав тему "Файл распух до нелогичных размеров" воспользовался находящимися в ней кодами для уменьшения веса своей книги. Макрос выдал ошибку 1004 с сообщением "Программный доступ к проекту Visual Basic не является доверенным" и выделил строку в макросе "With wb.VBProject.VBComponents" при этом создав копию моей книги (правда без макросов , выпадающих списков), но сохранив все данные и размером всего 917Кб! Скопировав в новую книгу свой макрос получилось 943Кб! Отлично! НО как только я его запустил вес файла стал 1,65 Мб...,т.е все вернулось на свое место. При этом книга не связана с другими, данные из вне макрос не добавляет, работа его связана с извлечением данных по условию с одного листа на другой и пересчетом некоторых формул. Подскажите можно ли в принципе решить данную проблему - ну ооочень хочется! Файл большой - приложить не получается. Спасибо!pechkin
Sub Макрос1() 'Извлекает данные из АРХИВА Dim iLastRow As Long, rw As Long, gLastRow As Long If Range("B1").Value = "" Then MsgBox "Введите значение" If vbOK Then Exit Sub End If Range("AB6:AB16").ClearContents Range("B6:D16").ClearContents Range("F6:F16").ClearContents Range("H6:H16").ClearContents Range("J6:L16").ClearContents Range("R6:R16").ClearContents Range("T6:T16").ClearContents Range("AK2:AL11").ClearContents 'Range("E7:E19").FormulaR1C1 = _ "=IF(OR(RC[-1]="""",R[-1]C[-1]=""""),"""",IF(R[-1]C[-3]=""Доп.дек.13"",(RC[-2]-R[-2]C[-2])*24+RC[-1]-R[-2]C[-1],(RC[-2]-R[-1]C[-2])*24+RC[-1]-R[-1]C[-1]))" 'Формула для столбца №5(Е)Фактическое время Range("E7:E19").FormulaR1C1 = _ "=IF(RC[-1]="""","""",IF(OR(RC[-3]=""пуск""&R3C4,AND(RC[-3]<>""Год.""&R3C4,ISERROR(MONTH(RC[-3])))),0,IF(OR(AND(R[-1]C=0,R[-1]C[-3]=""пуск""&R3C4),R[-1]C<>0),(RC[-2]-R[-1]C[-2])*24+RC[-1]-R[-1]C[-1],IF(AND(R[-1]C=0,R[-2]C=0),(RC[-2]-R[-3]C[-2])*24+RC[-1]-R[-3]C[-1],IF(R[-1]C=0,(RC[-2]-R[-2]C[-2])*24+RC[-1]-R[-2]C[-1],(RC[-2]-R[-1]C[-2])*24+RC[-1]-R[-1]C[-1])))))" 'Другая формула фактического времени Range("G7:G19").FormulaR1C1 = _ "=IF(RC[-1]="""","""",IF(R5C6=""часы"",IF(R[-1]C[-5]=""Доп.дек.13"",ABS(RC[-1]-R[-2]C[-1]),ABS(RC[-1]-R[-1]C[-1])),IF(R5C6=""сутки"",IF(R[-1]C[-5]=""Доп.дек.13"",ABS((RC[-1]-R[-2]C[-1])*24),ABS((RC[-1]-R[-1]C[-1])*24)))))" 'Формула для столбца №7(G)Время по счетчику Range("I7:I19").FormulaR1C1 = _ "=IF(RC[-3]="""","""",RC[-4]-RC[-2]-RC[-1])" 'Формула для столбца №9(I)Простой по времени Range("M7:M19").FormulaR1C1 = _ "=IF(OR(RC[-1]="""",RC[-11]=""Показ.""),0,IF(OR(R[-1]C[-11]=""Обнул."",R[-1]C[-11]=""Год.13""),RC[-1]+R[-1]C+R[-1]C[2],IF(OR(R[-1]C[-11]=""Тариф"",R[-1]C[-11]=""Показ.""),RC[-1]-R[-2]C[-1]-RC[-2],RC[-1]-R[-1]C[-1]-RC[-2])))" 'Формула для столбца №13(M)Разность Единиц Range("N7:N19").FormulaR1C1 = _ "=IF(RC[-1]=0,0,IF(R5C12=""ГДж"",ROUND(RC[-1]/4.19,2),IF(R5C12=""МВт"",ROUND(RC[-1]*0.86,2),IF(R5C12=""Гкал"",RC[-1]*1))))" 'Формула для столбца №14(N)Гкал Range("P7:P19").FormulaR1C1 = _ "=IF(OR(RC[-14]=""Обнул."",RC[-14]=""Год.13""),"""",SUM(RC[-2],RC[-1]))" 'Формула для столбца №16(P)Потребленная Энергия Range("Q7:Q19").FormulaR1C1 = "=IF(RC[-1]="""","""",ROUND(RC[-1]*R5C17+RC[-1],2))" 'Формула для столбца №17(Q)С учетом потерь Range("S7:S19").FormulaR1C1 = _ "=IF(RC[-1]=0,0,IF(R[-1]C[-17]=""Доп.дек.13"",RC[-1]-R[-2]C[-1],RC[-1]-R[-1]C[-1]))" Range("U7:U19").FormulaR1C1 = _ "=IF(RC[-1]=0,0,IF(R[-1]C[-19]=""Доп.дек.13"",RC[-1]-R[-2]C[-1],RC[-1]-R[-1]C[-1]))" Range("V7:V19").FormulaR1C1 = "=IF(RC[-2]="""","""",RC[-3]-RC[-1])" 'Разность между вычислителем и водомером Range("Z7:Z19").FormulaR1C1 = _ "=IF(OR(RC[-19]="""",RC[-19]=0),"""",ROUND(RC19/RC[-19],2))" Range("AB7:AB19").FormulaR1C1 = _ "=IF(OR(RC[-11]="""",RC[-11]=0),"""",ROUND(RC[-11]*RC[1]/RC[2],2))" Range("AC7:AC19").FormulaR1C1 = "=IF(OR(RC[-27]="""",RC[-27]=0),"""",R2C29)" Range("AD7:AD19").FormulaR1C1 = "=IF(OR(RC[-28]="""",RC[-28]=0),"""",R2C31)" Range("O7:O19").FormulaR1C1 = _ "=IF(RC[-12]="""","""",ROUND(R3C29*12/R2C30/24*RC[-5]*RC[15]/R2C29,2))" 'Формула ПРОСТОЯ
[/vba] Не влезло [vba][code][/code][/vba]
Прошу прощения за безграмотность[vba]
Код
Sub Макрос1() 'Извлекает данные из АРХИВА Dim iLastRow As Long, rw As Long, gLastRow As Long If Range("B1").Value = "" Then MsgBox "Введите значение" If vbOK Then Exit Sub End If Range("AB6:AB16").ClearContents Range("B6:D16").ClearContents Range("F6:F16").ClearContents Range("H6:H16").ClearContents Range("J6:L16").ClearContents Range("R6:R16").ClearContents Range("T6:T16").ClearContents Range("AK2:AL11").ClearContents 'Range("E7:E19").FormulaR1C1 = _ "=IF(OR(RC[-1]="""",R[-1]C[-1]=""""),"""",IF(R[-1]C[-3]=""Доп.дек.13"",(RC[-2]-R[-2]C[-2])*24+RC[-1]-R[-2]C[-1],(RC[-2]-R[-1]C[-2])*24+RC[-1]-R[-1]C[-1]))" 'Формула для столбца №5(Е)Фактическое время Range("E7:E19").FormulaR1C1 = _ "=IF(RC[-1]="""","""",IF(OR(RC[-3]=""пуск""&R3C4,AND(RC[-3]<>""Год.""&R3C4,ISERROR(MONTH(RC[-3])))),0,IF(OR(AND(R[-1]C=0,R[-1]C[-3]=""пуск""&R3C4),R[-1]C<>0),(RC[-2]-R[-1]C[-2])*24+RC[-1]-R[-1]C[-1],IF(AND(R[-1]C=0,R[-2]C=0),(RC[-2]-R[-3]C[-2])*24+RC[-1]-R[-3]C[-1],IF(R[-1]C=0,(RC[-2]-R[-2]C[-2])*24+RC[-1]-R[-2]C[-1],(RC[-2]-R[-1]C[-2])*24+RC[-1]-R[-1]C[-1])))))" 'Другая формула фактического времени Range("G7:G19").FormulaR1C1 = _ "=IF(RC[-1]="""","""",IF(R5C6=""часы"",IF(R[-1]C[-5]=""Доп.дек.13"",ABS(RC[-1]-R[-2]C[-1]),ABS(RC[-1]-R[-1]C[-1])),IF(R5C6=""сутки"",IF(R[-1]C[-5]=""Доп.дек.13"",ABS((RC[-1]-R[-2]C[-1])*24),ABS((RC[-1]-R[-1]C[-1])*24)))))" 'Формула для столбца №7(G)Время по счетчику Range("I7:I19").FormulaR1C1 = _ "=IF(RC[-3]="""","""",RC[-4]-RC[-2]-RC[-1])" 'Формула для столбца №9(I)Простой по времени Range("M7:M19").FormulaR1C1 = _ "=IF(OR(RC[-1]="""",RC[-11]=""Показ.""),0,IF(OR(R[-1]C[-11]=""Обнул."",R[-1]C[-11]=""Год.13""),RC[-1]+R[-1]C+R[-1]C[2],IF(OR(R[-1]C[-11]=""Тариф"",R[-1]C[-11]=""Показ.""),RC[-1]-R[-2]C[-1]-RC[-2],RC[-1]-R[-1]C[-1]-RC[-2])))" 'Формула для столбца №13(M)Разность Единиц Range("N7:N19").FormulaR1C1 = _ "=IF(RC[-1]=0,0,IF(R5C12=""ГДж"",ROUND(RC[-1]/4.19,2),IF(R5C12=""МВт"",ROUND(RC[-1]*0.86,2),IF(R5C12=""Гкал"",RC[-1]*1))))" 'Формула для столбца №14(N)Гкал Range("P7:P19").FormulaR1C1 = _ "=IF(OR(RC[-14]=""Обнул."",RC[-14]=""Год.13""),"""",SUM(RC[-2],RC[-1]))" 'Формула для столбца №16(P)Потребленная Энергия Range("Q7:Q19").FormulaR1C1 = "=IF(RC[-1]="""","""",ROUND(RC[-1]*R5C17+RC[-1],2))" 'Формула для столбца №17(Q)С учетом потерь Range("S7:S19").FormulaR1C1 = _ "=IF(RC[-1]=0,0,IF(R[-1]C[-17]=""Доп.дек.13"",RC[-1]-R[-2]C[-1],RC[-1]-R[-1]C[-1]))" Range("U7:U19").FormulaR1C1 = _ "=IF(RC[-1]=0,0,IF(R[-1]C[-19]=""Доп.дек.13"",RC[-1]-R[-2]C[-1],RC[-1]-R[-1]C[-1]))" Range("V7:V19").FormulaR1C1 = "=IF(RC[-2]="""","""",RC[-3]-RC[-1])" 'Разность между вычислителем и водомером Range("Z7:Z19").FormulaR1C1 = _ "=IF(OR(RC[-19]="""",RC[-19]=0),"""",ROUND(RC19/RC[-19],2))" Range("AB7:AB19").FormulaR1C1 = _ "=IF(OR(RC[-11]="""",RC[-11]=0),"""",ROUND(RC[-11]*RC[1]/RC[2],2))" Range("AC7:AC19").FormulaR1C1 = "=IF(OR(RC[-27]="""",RC[-27]=0),"""",R2C29)" Range("AD7:AD19").FormulaR1C1 = "=IF(OR(RC[-28]="""",RC[-28]=0),"""",R2C31)" Range("O7:O19").FormulaR1C1 = _ "=IF(RC[-12]="""","""",ROUND(R3C29*12/R2C30/24*RC[-5]*RC[15]/R2C29,2))" 'Формула ПРОСТОЯ
With Sheets("АРХИВ") .Range("A3:AC9000").Interior.ColorIndex = xlNone iLastRow = .Cells(Rows.Count, 1).End(xlUp).Row rw = 6 'Начало записей на Лист РАСЧЕТ For i = 1 To iLastRow ' Цикл вставки до последней подходящей строки If .Cells(i, 1).Value = Range("B1").Value Then Arr = .Range(.Cells(i, 3), .Cells(i, 13)) Cells(rw, 2).Resize(, UBound(Arr, 2)) = Arr 'Начиная со второго столбца Листа "Расчет" Вставляются данные из АРХИВА-с 3по13 столбец Arr = .Range(.Cells(i, 15), .Cells(i, 24)) Cells(rw, 13).Resize(, UBound(Arr, 2)) = Arr Cells(rw, 26) = .Cells(i, 25) Arr = .Range(.Cells(i, 27), .Cells(i, 29)) Cells(rw, 28).Resize(, UBound(Arr, 2)) = Arr Range(.Cells(i, 1), .Cells(i, 29)).Interior.ColorIndex = 35 rw = rw + 1 End If Next End With
If Range("Q5").Value = 0 Then Columns("Q:Q").EntireColumn.Hidden = True Else Columns("Q:Q").EntireColumn.Hidden = False End If If Range("L5").Value = "Гкал" Then Columns("N:N").EntireColumn.Hidden = True Else Columns("N:N").EntireColumn.Hidden = False End If
gLastRow = Cells(Rows.Count, 2).End(xlUp).Row If Range("B4").Value <> Cells(gLastRow, 2).Value Then 'Условие не вставлять одинаковый месяц Cells(gLastRow + 1, 2).Value = Range("B4").Value 'Вставка в первую пустую ячейку столба 2 значения из В4 месяц расчета End If If Cells(gLastRow + 1, 2).Value > 0 Then Cells(gLastRow + 1, 3).Value = Range("D4").Value End If If Sheets("РАСЧЕТ").Range("C1").Value = Sheets("АКТ").Range("I5").Value Then Sheets("АКТ").Select End If
End Sub
[/vba]
[vba]
Код
gLastRow = Cells(Rows.Count, 2).End(xlUp).Row
With Sheets("АРХИВ") .Range("A3:AC9000").Interior.ColorIndex = xlNone iLastRow = .Cells(Rows.Count, 1).End(xlUp).Row rw = 6 'Начало записей на Лист РАСЧЕТ For i = 1 To iLastRow ' Цикл вставки до последней подходящей строки If .Cells(i, 1).Value = Range("B1").Value Then Arr = .Range(.Cells(i, 3), .Cells(i, 13)) Cells(rw, 2).Resize(, UBound(Arr, 2)) = Arr 'Начиная со второго столбца Листа "Расчет" Вставляются данные из АРХИВА-с 3по13 столбец Arr = .Range(.Cells(i, 15), .Cells(i, 24)) Cells(rw, 13).Resize(, UBound(Arr, 2)) = Arr Cells(rw, 26) = .Cells(i, 25) Arr = .Range(.Cells(i, 27), .Cells(i, 29)) Cells(rw, 28).Resize(, UBound(Arr, 2)) = Arr Range(.Cells(i, 1), .Cells(i, 29)).Interior.ColorIndex = 35 rw = rw + 1 End If Next End With
If Range("Q5").Value = 0 Then Columns("Q:Q").EntireColumn.Hidden = True Else Columns("Q:Q").EntireColumn.Hidden = False End If If Range("L5").Value = "Гкал" Then Columns("N:N").EntireColumn.Hidden = True Else Columns("N:N").EntireColumn.Hidden = False End If
gLastRow = Cells(Rows.Count, 2).End(xlUp).Row If Range("B4").Value <> Cells(gLastRow, 2).Value Then 'Условие не вставлять одинаковый месяц Cells(gLastRow + 1, 2).Value = Range("B4").Value 'Вставка в первую пустую ячейку столба 2 значения из В4 месяц расчета End If If Cells(gLastRow + 1, 2).Value > 0 Then Cells(gLastRow + 1, 3).Value = Range("D4").Value End If If Sheets("РАСЧЕТ").Range("C1").Value = Sheets("АКТ").Range("I5").Value Then Sheets("АКТ").Select End If
Nilem - Спасибо за ответы! В файле строки с запасом, т.к. данные будут добавляться. RAN - Спасибо! Если все убрать-то смысл тогда в чем? В том то и вопрос - почему файл с формулами и раскраской на рабочем листе, с текстом макроса , но не запущенного весит почти в два раза меньше, чем после работы этого макроса?
Nilem - Спасибо за ответы! В файле строки с запасом, т.к. данные будут добавляться. RAN - Спасибо! Если все убрать-то смысл тогда в чем? В том то и вопрос - почему файл с формулами и раскраской на рабочем листе, с текстом макроса , но не запущенного весит почти в два раза меньше, чем после работы этого макроса?pechkin
Наверное, все из-за листа "Архив" Сначала на этом листе удалите все неиспользуемые строки снизу, начиная с самой последней (нажимаем Ctrl+End и будет выделена последняя используемая на листе ячейка. Вот от этой строки и вверх до диапазона с данным удаляем строки целиком). Сохраните файл. Посмотрите, изменился ли размер. Теперь в коде вместо [vba]
Код
With Sheets("АРХИВ") .Range("A3:AC9000").Interior.ColorIndex = xlNone
[/vba] напишите [vba]
Код
With Sheets("АРХИВ") .UsedRange.Interior.ColorIndex = xlNone
[/vba] выполните макрос, сохраните файл и посмотрите на размер
Наверное, все из-за листа "Архив" Сначала на этом листе удалите все неиспользуемые строки снизу, начиная с самой последней (нажимаем Ctrl+End и будет выделена последняя используемая на листе ячейка. Вот от этой строки и вверх до диапазона с данным удаляем строки целиком). Сохраните файл. Посмотрите, изменился ли размер. Теперь в коде вместо [vba]
Код
With Sheets("АРХИВ") .Range("A3:AC9000").Interior.ColorIndex = xlNone
[/vba] напишите [vba]
Код
With Sheets("АРХИВ") .UsedRange.Interior.ColorIndex = xlNone
[/vba] выполните макрос, сохраните файл и посмотрите на размерnilem
На листе Архив изпользовалось пока около 800 строк. Первый Ваш совет не помог, т.к удалять было нечего.А вот второй!!! Все получилось. С Вашей подсказкой файл после выполнения макроса почти не увеличился! Проделал для полной уверенности несколько раз. Потом убедился, что с предидущим текстом макроса на листе Архив строк становится 9000!!! Еще раз СПАСИБО!!!
На листе Архив изпользовалось пока около 800 строк. Первый Ваш совет не помог, т.к удалять было нечего.А вот второй!!! Все получилось. С Вашей подсказкой файл после выполнения макроса почти не увеличился! Проделал для полной уверенности несколько раз. Потом убедился, что с предидущим текстом макроса на листе Архив строк становится 9000!!! Еще раз СПАСИБО!!!pechkin
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
