МатросНаЗебре, извиняюсь, а как сначала удалить ВСЕ стандарт модули, модули класс, формы, модули листов и книг в обрабатываемой книге, а ПОТОМ производить импорт модулей? Вижу процесс таким: 1) Запуск кода замены макросов в Книге (1) 2) Выбор папки с книгами, в которых необходимо менять макрососодержимое 3) Цикл перебора книг из папки, в котором: 3.1) Удаляем все модули, формы, чистим модули листОВ и книги 3.2) Импортируем ПРОПИСАННЫЕ РУКАМИ В КОДЕ модули и формы 3.3) Переходим к обработки следующей книги
МатросНаЗебре, В коде есть пометка «' Не возвращает имена модулей листов и ЭтаКнига.» Будь добры, подскажите, как сделать так, чтобы кода модулей листов и ЭтаКнига тоже учитывались. Спасибо!
Доброго времени суток, уважаемые! Всех, с прошедшими праздниками, повсеместного добра вам и вашим близким, здоровья ранее указанным
По существу: будьте добры, подскажите, пожалуйста, код либо альтернативный способ реализации массового обновления макросов в книгах.
Дано: Есть (1) Основная книга, которая содержит в себе последние версии макросов и (2) Папка с 1000 книг, которые содержат в себе полностью идентичные коды в Модулях и в Листах и Формах.
Каким образом возможно реализовать массовое обновление Модулей, Листов, Форм в 1000 книг, взяв за образец то, что в Основной книге?
Действует этот рецепт только для файлов новых форматов Excel 2007 и выше: 1. Обязательно делаем резервную копию файла, связи в котором никак не хотят разрываться 2. Открываем файл при помощи любого архиватора(WinRAR отлично справляется, но это может быть и другой, работающий с форматом ZIP) 3. В архиве перейти в папку xl -> externalLinks 4. Сколько связей содержится в файле, столько файлов вида externalLink1.xml и будет внутри. Файлы просто пронумерованы и никаких сведений о том, к какому конкретному файлу относится эта связь на поверхности нет. Чтобы узнать какой файл .xml к какой связи относится надо зайти в папку "_rels" и открыть там каждый из имеющихся файлов вида externalLink1.xml.rels. Там и будет содержаться имя файла-источника. 5. Если надо удалить только связь на конкретный файл - удаляем только те externalLink1.xml.rels и externalLink1.xml, которые относятся к нему. Если удалить надо все связи - удаляем все содержимое папки externalLinks 6. Закрываем архив 7. Открываем файл в Excel. Появится сообщение об ошибке вроде "Ошибка в части содержимого в Книге ...". Соглашаемся. Появится еще одно окно с перечислением ошибочного содержимого. Нажимаем закрыть.
Доброго времени суток. В приложенных файлах есть книга, в которое есть неведомое соединение, которое не удается разорвать, отключить, удалить. Будьте добры, пожалуйста, помогите избавиться от этого соединения. С чем такое может быть связано? Спасибо!
Подскажите, пожалуйста, код, которым возможно осуществить операцию по замене ТЕКСТА, скажем, например «Информация» на ФОРМУЛУ «=2+2*2». Операция необходимо совершить на всех листах книги ( включая скрытые ) во всех ячейках, содержание которых совпадает с искомым текстом ПОЛНОСТЬЮ. Регистр - неважен. Спасибо!
upd: Макрорекодер сообщаеТ следующее:
Код
Cells.Replace What:="Информация за указанный период", Replacement:= _
"=""Расход топлива за "" & ТЕКСТ(ДАТАМЕС(0;$L$7);""ММММ"") & "" "" & $L$9 & "" г.""" _
, LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
При повторном запуске, код не осуществляет никаких действий.
Sub Create_NewModule()
Dim objVBProj As Object, objVBComp As Object, objCodeMod As Object
Dim sModuleName As String, sFullName As String
Dim sProcLines As String
Dim lLineNum As Long
'добавляем новый стандартный модуль в активную книгу
Set objVBComp = ActiveWorkbook.VBProject.VBComponents.Add(1)
'получаем ссылку на коды модуля
Set objCodeMod = objVBComp.CodeModule
'узнаем количество строк в модуле
'(т.к. VBA в зависимости от настроек может добавлять строки деклараций)
lLineNum = objCodeMod.CountOfLines + 1
'текст всставляемой процедуры
sProcLines = "Sub Test()" & vbCrLf & _
" MsgBox ""Hello, World""" & vbCrLf & _
"End Sub"[SIZE=36pt][/SIZE]
'вставляем текст процедуры в тело нового модуля
objCodeMod.InsertLines lLineNum, sProcLines
End Sub
Доброго времени суток! Необходимо обработать n-ое кол-во книг и проверить каждую на предмет наличия модуля с именем «Module1» и, если он есть - удалить в нем все строки, если его нет - создать пустой модуль с именем «Module1»
Часть кода у меня написана. Необходимо составить ту часть, которая проверяет, чистит или создает новый модуль «Module1»
Доброго времени суток! Столкнулся с простой сложностью: не могу нагуглить, разобраться и понять ( видимо, плохо делаю ) , как определить минимальную дату в таблице, важный столбец которой содержит в себе помимо значений дат, еще и пустые строки, которые необходимо игнорировать в формуле определения минимальной даты.
Прошу помощи, совета! Спасибо! Скрин и сам файл-пример прилагаю.
Доброго времени суток! Не работать формула СУММ при подсчете сумм ячеек, которые содержат в себе «=ТЕКСТ($C$3*$D$3;"##0 000,00")» и подобное. Файл пример - в приложениях + скрин.
Какая может быть причина и как возможно это исправить? Спасибо!
Sub ВидыТопливаЛитрыСредняяЦена()
Sheets("ГПН").Select
'===============Создаем словарь===========
Dim dic
Set dic = CreateObject("Scripting.Dictionary") 'создаем словарь
dic.CompareMode = TextCompare ' текстовый режим - игнорирует регистр
For i = 2 To Cells(Rows.Count, 3).End(xlUp).row 'цикл с ДВАДЦАТОЙ строки листа до последней заполненной
If Range("B" & i) <> "" Then
k = Range("D" & i) 'создаем ключ для словаря сцепкой ячеек. Все ключи в словаре уникальны
it = Range("E" & i) 'значение по ключу, в примере - количество
If dic.Exists(k) Then 'проверяем, есть ли уже такой ключ в словаре
dic.item(k) = dic.item(k) + it 'если есть, суммируем колличество с тем, что уже было ранее
Else
dic.Add k, it 'если нет, делаем в словаре новую запись
End If
End If
Next
Rows("1:" & dic.Count + 7).Insert 'вставляем сверху строки
СтрокаВыгрузки = 1 'строка формирования заголовка и первая строка для выгрузки данных
Range("A" & СтрокаВыгрузки) = "Вид топлива"
Range("B" & СтрокаВыгрузки) = "Кол-во л."
i = СтрокаВыгрузки + 1 'с этой строки будем выгружать данные из словаря
For Each ky In dic.keys 'цикл переборки всех записанных ключей
ar = ky 'разделяем сцепку обратно, получаем два элемента
Range("A" & i) = ar 'записываем эти элементы в ячейки
Range("B" & i) = dic.item(ky) 'записываем в ячейку количество
i = i + 1 'переходим к следующей строке
k = 1
k = k + 1
Next
'Сортировка полученных значений
Range("A" & СтрокаВыгрузки & ":B" & dic.Count + 1).Select
ActiveWorkbook.Worksheets("ГПН").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ГПН").Sort.SortFields.Add key:=Range("A" & СтрокаВыгрузки + 1 & ":A" & dic.Count + 1), _
SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"Аи-92,Аи-95,G-95,ДТ,G-Drive 100,СУГ", DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("ГПН").Sort
.SetRange Range("A" & СтрокаВыгрузки & ":B" & dic.Count + 1)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ThisWorkbook.ActiveSheet.Sort.SortFields.Clear
dic.RemoveAll ' удаляем словарь
End Sub
Sub ВидыТопливаЛитрыСредняяЦена()
Sheets("ГПН").Select
'===============Создаем словарь===========
Dim dic
Set dic = CreateObject("Scripting.Dictionary") 'создаем словарь
dic.CompareMode = TextCompare ' текстовый режим - игнорирует регистр
For i = 2 To Cells(Rows.Count, 3).End(xlUp).row 'цикл с ДВАДЦАТОЙ строки листа до последней заполненной
If Range("B" & i) <> "" Then
k = Range("D" & i) 'создаем ключ для словаря сцепкой ячеек. Все ключи в словаре уникальны
it = Range("E" & i) 'значение по ключу, в примере - количество
If dic.Exists(k) Then 'проверяем, есть ли уже такой ключ в словаре
dic.item(k) = dic.item(k) + it 'если есть, суммируем колличество с тем, что уже было ранее
Else
dic.Add k, it 'если нет, делаем в словаре новую запись
End If
End If
Next
Rows("1:" & dic.Count + 7).Insert 'вставляем сверху строки
СтрокаВыгрузки = 1 'строка формирования заголовка и первая строка для выгрузки данных
Range("A" & СтрокаВыгрузки) = "Вид топлива"
Range("B" & СтрокаВыгрузки) = "Кол-во л."
i = СтрокаВыгрузки + 1 'с этой строки будем выгружать данные из словаря
For Each ky In dic.keys 'цикл переборки всех записанных ключей
ar = ky 'разделяем сцепку обратно, получаем два элемента
Range("A" & i) = ar 'записываем эти элементы в ячейки
Range("B" & i) = dic.item(ky) 'записываем в ячейку количество
i = i + 1 'переходим к следующей строке
k = 1
k = k + 1
Next
'Сортировка полученных значений
Range("A" & СтрокаВыгрузки & ":B" & dic.Count + 1).Select
ActiveWorkbook.Worksheets("ГПН").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ГПН").Sort.SortFields.Add key:=Range("A" & СтрокаВыгрузки + 1 & ":A" & dic.Count + 1), _
SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"Аи-92,Аи-95,G-95,ДТ,G-Drive 100,СУГ", DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("ГПН").Sort
.SetRange Range("A" & СтрокаВыгрузки & ":B" & dic.Count + 1)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ThisWorkbook.ActiveSheet.Sort.SortFields.Clear
dic.RemoveAll ' удаляем словарь
End Sub
Настя_Nastya, нужен именно код vba. Wiss, бесспорно, решение отличное, но у меня уже настроено все на словарь и его ключи необходимо сортировать по алфавиту Mershik, подсчет суммы по каждому виду - есть! Необходимо организовать сортировку по ключу (по виду топлива) vikttur, есть!