Заменить ячейки с определенной формулой на значения
Пользователь
Сообщений: Регистрация: 13.12.2023
delf3r
31.10.2025 15:26:36
Добрый день!
Подскажите как доработать макрос, чтобы он перебирал все листы книги, а не только активный. Спасибо за помощь!
Код
Sub ttARM()
Dim Rng As Range
For Each Rng In ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
If InStr(Rng.Formula, "VLOOKUP") > 0 Then Rng.Value = Rng.Value
End If
Next
End Sub
Макрос выбора файла в каталоге заменить на папку текущего файла
Пользователь
Сообщений: Регистрация: 13.12.2023
delf3r
12.08.2025 08:01:17
Добрый день! Подскажите как изменить код (нашел на просторах интернета):
Код
Sub Sbor_imen_failov_i_stranic()
Dim i As Long
Dim xRg As Range
Dim xStr As String
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Dim xFileNum As Long
Dim RegExp As Object
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.pdf", vbDirectory)
Worksheets.Add.Name = "Приложения"
Set xRg = Sheets("Приложения").Range("A1")
Range("A:B").ClearContents
Range("A1:B1").Font.Bold = True
xRg = "Имя файла"
xRg.Offset(0, 1) = "Кол-во страниц"
i = 2
xStr = ""
Do While xFileName <> ""
Cells(i, 1) = xFileName
Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = True
RegExp.Pattern = "/Type\s*/Page[^s]"
xFileNum = FreeFile
Open (xFdItem & xFileName) For Binary As #xFileNum
xStr = Space(LOF(xFileNum))
Get #xFileNum, , xStr
Close #xFileNum
Cells(i, 2) = RegExp.Execute(xStr).Count
i = i + 1
xFileName = Dir
Loop
Columns("A:B").AutoFit
End If
End Sub
Чтобы вместо открытия диалога с выбором файлов, выбирались файлы из папки, в которой находится текущий файл Excel, из которого запускается макрос. Понимаю, что здесь нужно изменить часть кода:
Код
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
но знаний не хватает как скорректировать. Спасибо за помощь!
Изменено: - 12.08.2025 08:01:44
Переключение между книгами макросом
Пользователь
Сообщений: Регистрация: 13.12.2023
delf3r
25.07.2025 12:21:26
Добрый день! Прошу помочь. Набрал макрос из нескольких других для своих целей, но не хватает знаний, чтобы соединить их воедино и не вылетала ошибка. По отдельности они прекрасно работают.
Код
Sub Подготовка_удалить_колонки()
'Первая часть макроса: Перемещаем листы в новую книгу
Dim ActiveSht As Worksheet
Dim NewWb As Workbook
For Each ActiveSht In ThisWorkbook.Worksheets
ActiveSht.Visible = True ' делаем скрытые листы видимыми в исходной книге.
Next
Sheets(Array("Исходные данные", "Сопровод", "ПЗ МЭР", "ПЗ", "КЦ", "Справочник")).Move ' Здесь указываете имена нужных листов
Set NewWb = ActiveWorkbook
For Each ActiveSht In NewWb.Worksheets
With ActiveSht.UsedRange
.Value = .Value
End With
Next
'NewWb.SaveAs FileName:="C:\" & "Копия.xls" ' листов стало много - какое имя нужно давать для книги не знаю.
MsgBox "Формы документов перенесены в новую книгу и сохранены.", , ""
'ThisWorkbook.Close SaveChanges:=False
'Вторая часть макроса: удаление внешних связей
exist_links = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(exist_links) Then
For i = LBound(exist_links) To UBound(exist_links)
' MsgBox exist_links(i)
ActiveWorkbook.BreakLink name:=exist_links(i), Type:=xlLinkTypeExcelLinks
Next
Else
MsgBox "Связей не найдено"
End If
'Третья часть макроса: Настройка формата под себя
Set wb = ActiveWorkbook
'Sheets("Исходные данные").UsedRange.Value = Sheets("Исходные данные").UsedRange.Value
'Sheets("ПЗ МЭР").UsedRange.Value = Sheets("ПЗ МЭР").UsedRange.Value
'Sheets("ПЗ").UsedRange.Value = Sheets("ПЗ").UsedRange.Value
Application.DisplayAlerts = False
Sheets("Справочник").Delete
Application.DisplayAlerts = True
'Sheets("КЦ").Visible = xlSheetsHidden
Sheets("Ф.1(1д)").Visible = xlSheetsHidden
...
Проблема возникает со второй части, т.к. в первой части переносятся листы в новую книгу и получается, что эта книга становится "активной" и уже вторая часть - удаление внешних связей работает в этой новой книге, но по факту связи должны разрываться в изначальной книге. Вопрос: как сделать первичную книгу активной (*наименование первичной книги может быть любым). И далее как потом опять не нарваться на такую же проблему при переходе в третью часть макроса? Спасибо за ответ!
P.S. Конец макроса выложен не полностью, потому что он огромный и содержит "личную" информацию, прошу не судить строго.
Выделение диапазона ячеек макросом
Пользователь
Сообщений: Регистрация: 13.12.2023
delf3r
25.07.2025 09:34:39
Добрый день! Прошу помочь. В данной теме нашел макрос: Использую его чтобы в книге на листах превратить табличную часть в значения.
И вот на ней происходит ошибка. Т.е. полностью код выглядит так:
Код
Sub Тест_выделения_диапозона()
Sheets("A").Range("D14", Cells(Rows.Count, "X").End(xlUp).Offset(, 3)).Value = Sheets("A").Range("D14", Cells(Rows.Count, "X").End(xlUp).Offset(, 3)).Value
Sheets("B").Range("D14", Cells(Rows.Count, "X").End(xlUp).Offset(, 3)).Value = Sheets("B").Range("D14", Cells(Rows.Count, "X").End(xlUp).Offset(, 3)).Value
End Sub
Как можно исправить? Пример приложил. Спасибо за ответ!
Форма в Excel сформирована, как объединенные микростолбцы
Пользователь
Сообщений: Регистрация: 13.12.2023
delf3r
10.03.2025 14:52:23
Добрый день! Подскажите существует ли способ (не ручной) переделать ЭТО в нормальный вид таблицы, где каждая ячейка = одной ячейке, а не каждая ячейка = много ячеек объеденных в одну? Пример во вложении. Спасибо!
Сохранение пользовательской функции при копировании листа
Пользователь
Сообщений: Регистрация: 13.12.2023
delf3r
10.02.2025 09:33:36
Добрый день!
Подскажите знающие люди.. Условия задачи: Файл Excel с пользовательской функцией (называется: "СцепитьЕсли2") записана, как модуль VBA при помощи Function, которая используется на листе. При создании копии в новую книгу в ячейке, где была пользовательская функция появляется ошибка "#ИМЯ?". Вопрос: Как сохранить пользовательскую функцию при создании копии в новую книгу и не было соответствующей ошибки.
Мои попытки: -Вынести функцию в отдельную книгу путем сохранения в формате "надстройка Excel, формат .xlam". Автоматически открывать эту книгу при открытии основной книги. Для этого использую макрос, который записываю в VBA Эта книга:
Код
Sub Auto_Open()
Workbooks.Open Filename:="...\СцепитьЕсли2.xlam"
End Sub
Эффект - не работает. Получается книга не открывается макросом... поэтому не работает. Когда открываю книгу руками, то работает. Может надо как-то докрутить и я что-то не учел? Или предложите другое решение. Спасибо!
Вывести диапозон целых чисел между двух чисел с дальнейшими математическими расчетами
Пользователь
Сообщений: Регистрация: 13.12.2023
delf3r
06.02.2025 11:05:56
Добрый день! Прошу помощи..
Описание задачи:
Т.е. мы задаем в столбец "Базовый год" строку "Год" и строку "Цена",
потом задаем слобец "Планируемый год" строку год".
Столбец "Индекс" должен "понять", что в диапозон между 2020 и 2016 гг. входят 2017, 2018, 2019, 2020 и взять произведение индексов из таблицы соответствующие годам.
В итоге столбец "Планируемый год" строка "Цена" заполняется автоматически умножением Цены Базового года x Индекс = Цену Планируемого года.
Вопрос: Как можно получить индекс путем ввода только Базового года и Планируемого года?*
*Понятно, что хочется способа более компактного, чем мой, т.к. какая тут таблица (здоровенная) будет, если закончить ее полностью.
Файлик приложил.
Спасибо за помощь!
P.S. В распоряжении только Excel 2016
Изменено: - 06.02.2025 11:12:28
Power Query. Объединение таблиц с множеством условий, Power Query. Объединение таблиц с множеством условий
Пользователь
Сообщений: Регистрация: 13.12.2023
delf3r
22.05.2024 08:05:28
Добрый день!
Прошу помочь в решении задачи каким-либо образом (написать код, скинуть ссылку на подобную тему, подсказать какие формулы могут помочь или может вообще как-то подойти с другой стороны).
Описание. Есть 2 таблицы: -Таблица Лист1 - данные о необходимых материалах с кодом и применяемостью и периодом ограничения по датам приходов; -Таблица Лист2 - данные о пришедших материалах, дата прихода, количество, цена и обоснование. Таблицу Лист1, нужно объединить с таблицей Лист2. Таблица Лист1 - главная.
Цель. Чтобы при объединении таблиц Лист1 (к которой подцепляю) и Лист2 (которую подцепляю) можно было добавить условия: 1)Дата Лист2 вписывалась в отрезок Период начала-Период конца; 2)Так же, чтобы Количество Лист2 меньше или равно Применяемости Лист1; 3)Исходя из вышеперечисленных условий считалась средняя цена из Лист2; 4)И выводились все причастные обоснования из Лист2 (типа Сцепить "Обоснование, Обоснование"); Т.е. условия 1) и 2) выполнялись одновременно. Примерно что хочется получить в Листе "Примерный итог".
Что делаю. Моих знаний хватает на то, чтобы сформировать из каждой таблицы Лист1 и Лист2 запросы, далее объединить их и... всё.. (Лист3). Вообще понимания нет возможно ли решить такое через PQ. Аналогов не нашел особо.
Пример приложил.
Заранее спасибо за помощь!
P.S. Если гиблое дело пытаться так решить прошу тоже написать об этом!
Сравнение трех и более таблиц на разных листах excel, Сравнение трех и более таблиц на разных листах excel
Пользователь
Сообщений: Регистрация: 13.12.2023
delf3r
19.04.2024 05:10:39
Добрый день!
Прошу подсказать макрос для сравнения вновь добавленного листа "Последняя таблица" с табличными данными с другими листами Т1, Т2, Т3 на предмет соответствия по колонке B (количество строк с данными по колонке B может быть разное).
Каждый раз будет добавляться новый лист и их количество будет увеличиваться, но всегда нужно будет крайний добавленный лист сравнивать по колонке B с предыдущими таблицами Т1, Т2, Т3 по колонке B соответственно и тд.
И если данные на листе "Последняя таблица" в колонке B идентичны с какой-либо другой таблицей, то закрашивать колонки в этих двух таблицах и выводить название листа, с которым соответствие произошло.
*Порядок данных в колонке B может быть рандомным по нумерации, но одинаковым по содержанию. Это считается, что данные совпадают идентично.
Заранее спасибо кто откликнется!
Пример во вложении.
Изменено: - 19.04.2024 06:04:46
Power Query: Сбор данных из таблиц с определенной страницы, Power Query: Сбор данных из таблиц с определенной страницы
Пользователь
Сообщений: Регистрация: 13.12.2023
delf3r
14.12.2023 06:11:30
Добрый день!
Есть такие исходные данные. В Power Query объединяю несколько Excel-файлов способом по этой ссылке: , но только на "шаге 5" использую формулу:
Table.SelectRows(Excel.Workbook([Content]), each [Name]="Цена")[Data]{0}
чтобы "вытянуть" данные из определённого листа "Цена". Фильтром выбираю, чтобы выводились данные только Колонки 8 и Колонки 9 и получается следующее: и при переходе в столбце Content в ячейку Binary, то там следующие данные:
переходим в Table в третьей строке с названием "Цена" и тут есть такие данные
Внимание вопрос: какую формулу в Пользовательской колонке необходимо прописать, чтобы она заполнилась информацией из всех файлов из листов "Цена" из строки 4 колонки номер 9? *Листы во всех файлах имеют одинаковое название "Цена".
Пример приложил, но не знаю будет ли он работать.
Побочный вопрос (если можно ответить да/нет и немного развернуть): можно ли вообще сделать так в Power Query в моем случае, чтобы данные выводились не «друг под другом», а «в горизонталь»? * так же по две колонки (Колонка 8 и Колонка 9) из каждого листа "Цена" из разных файлов?