Пример прилагаю. Основная проблема это подчиненные строки (например 1.1 относящиеся к работе 1) и необходимость вывести наименование раздела. Там где раздел цена без НДС =0 Где есть подчиненные строки например п.60 60.1 60.2 60.3 60.4 работа п.60 равна всего по позиции минус сумма (стоимостей позиций 60.1+60.2+60.3+60.4) Массив материалов примерно в столбце J получился а как условия подчиненности применить не могу сообразить
Функция ЕСЛИОШИБКА - Служба поддержки Майкрософт (microsoft.com) Столкнулся со странным поведением Формируется динамический массив фильтруются данные по условию. Дописал еслиошибка, когда данных нет чтоб выводило прочерк, но получил неожиданный для себя вариант
Добрый день столкнулся в очередной раз с разной формой вывода документа при экспорте в пдф через макрос, печати через принтер Microsoft print to pdf и adobe pdf. Бывает не совпадает даже формат. Хотелось бы повторять в точности пдф который настроен на листе Эксель, а не а4, другой формат, другая граница печати на настроенном формате, удовлетворяющим меня предварительным просмотром
Добрый день, поискал в интернете примеры макросов на создание папок и подпапок и попробовал что-то сделать для себя похожее. Пример во вложении. Вроде в коде отключаю вывод сообщений но при работе макроса они вылазят и довольно много Не удается создать папку. Системе не удается найти указанный путь. Не могу разобраться с причиной этой ситуации и не создания некоторых подпапок В ячейке B1 формулой определяется путь где сохранен этот файл. Далее сам макрос циклом проходит по заполненным строкам столбца B и создает Основные папки и в нем вложенный цикл на создание подпапок. Помогите пожалуйста разобраться почему эти сообщения выскакивают вообще?
Код
Sub Создать_папки()
Application.ScreenUpdating = False 'Отключаем обновление экрана
Application.EnableEvents = False 'Отключаем отслеживание событий
Application.DisplayAlerts = False 'Отключаем вывод сообщений во время макроса
Dim cell As Range, newPath$
' цикл с 4-й по 500-ю с запасом
For i = 4 To 500
If Cells(i, 2).Value <> 0 Then
k = R_S(Cells(i, 2).Value) ' Убираем запрещенные символы имен
For j = 3 To 12
' формируем путь
newPath$ = Cells(1, 2).Value & k & "\" & Cells(i, j).Value
' создаем папки с подпапками
SHCreateDirectoryEx Application.hwnd, newPath$, ByVal 0&
Next j
End If
Next i
Exit Sub
Application.ScreenUpdating = True 'Включаем обновление экрана
Application.EnableEvents = True 'Включаем отслеживание событий
Application.DisplayAlerts = True 'Включаем вывод сообщений во время макроса
End Sub
#If VBA7 Then ' Office 2010-2013
Declare PtrSafe Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" _
(ByVal hwnd As LongPtr, ByVal pszPath As String, ByVal psa As Any) As LongPtr
#Else ' Office 2003-2007
#If Win64 Then
Declare PtrSafe Function SHCreateDirectoryEx Lib "shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As LongPtr
#Else
Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" _
(ByVal hwnd As Long, ByVal pszPath As String, ByVal psa As Any) As Long
#End If
#End If
Function CreateFolderWithSubfolders(ByVal newPath$) '--- создает папки по пути (Path)
' функция получает в качестве параметра путь к папке
' если такой папки ещё нет - она создаётся
' может создаваться сразу несколько подпапок
If Len(Dir(newPath$, vbDirectory)) = 0 Then ' если папка отсутствует
SHCreateDirectoryEx Application.hwnd, newPath$, ByVal 0& ' создаём путь
End If
End Function
Function R_S(ByVal txt As String) As String
St$ = "~!@/\#$%^&*=|`"""
For i% = 1 To Len(St$)
txt = Replace(txt, Mid(St$, i, 1), "_")
Next
R_S = txt
End Function
Добрый день. Имеется файл PageText.txt на рабочем столе Пробую скопировать с него информацию в эксель
Код
Sub Открыть()
ПутьКРабочемуСтолу = CreateObject("WScript.Shell").SpecialFolders("Desktop")
Workbooks.OpenText ПутьКРабочемуСтолу & "\PageText.txt", , , xlDelimited
End Sub
Информация открывается в эксель урезанная из-за ограничения символов в ячейке Почитал интернет содержимое похоже на json. Хочу получить по столбцам fileName | linkDownload | statusAttach и скачать все linkDownload в папку или гиперссылкой кликабельной в эксель
Установлен Adobe Acrobat XI Pro Есть файл pdf с графикой и текстом. Если его открывать и заменять вхождение слова на другое, то будет заменять по одному найденному вхождению и следующая замена опять надо клацать пробелом или мышкой. Если таких слов нужно заменить много - то довольно муторное занятие. Есть какие-то способы массовой замены текстового вхождения в пдф файле? При открытии файла pdf с помощью блокнота - нужные слова не ищет, может там как-то можно кодировку поменять чтоб слова найти заменить и перекодировать обратно, сохранить и открыть файл и все волшебным образом измениться? Я попробовал сохранить как .html - затем открыл блокнотом и заменил сразу нужное вхождение. А вот обратно файл создать pdf из веб страницы - не получилось.
Хотелось бы склонять существительные стандартными средствами Excel. Поискал в интернете где вообще можно просклонять слово или словосочетания. Толкового ничего не нашёл. Допустим в A1 вводим в именительном падеже слово для склонения, например картошка или генеральный директор Может кто-нибудь знает какие то веб сервисы которые позволят это сделать?
Добрый день, Есть код загрузки списка файлов Файлы находящиеся в папке имеют вид 1-2.1-а, 2-2.1-а, 3-2.1-а и.т.д. и порядок сортировки по имени в папке совпадает с тем порядком который я бы хотел видеть в таблице Но В коллекцию добавляются 1-2.1-а, 10-2.1-а, 11-2.1-а, и.т.д. Можно ли побороть этот эффект?
Код
Sub ЗагрузкаСпискаФайлов()
Dim coll As Collection, ПутьКПапке$, МаскаПоиска$, ГлубинаПоиска%
ПутьКПапке$ = [C1] ' берём из ячейки c1
МаскаПоиска$ = [c2] ' берём из ячейки c2
ГлубинаПоиска% = Val([C3]) ' берём из ячейки c3
If ГлубинаПоиска% = 0 Then ГлубинаПоиска% = 999 ' без ограничения по глубине
Set coll = FilenamesCollection(ПутьКПапке$, МаскаПоиска$, ГлубинаПоиска%)
Application.ScreenUpdating = False ' отключаем обновление экрана
For i = 1 To coll.Count ' перебираем все элементы коллекции, содержащей пути к файлам
НомерФайла = i
ПутьКФайлу = coll(i)
ИмяФайла = Dir(ПутьКФайлу)
Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 3).Value = _
Array(НомерФайла, ИмяФайла, ПутьКФайлу)
ActiveSheet.Hyperlinks.Add Range("b" & Rows.Count).End(xlUp), ПутьКФайлу, "", _
"Открыть файл" & vbNewLine & ИмяФайла
DoEvents ' временно передаём управление ОС
Next
End Sub
Добрый день! (Файл уже достаточно нагруженный 25 Мб - в сети) Как можно очистить неиспользуемые строки на одном из листов начиная с 500 до 1048438 Становлюсь на 500 и вниз - строки - удалить не хватает памяти, после чего грузит процессор на 100 и только снять задачу помогает
Добрый день, подскажите пожалуйста как запись вида
Код
If Cells(i, 1) = "6.3" Or Cells(i, 1) = "9.27" Or Cells(i, 1) = "9.30" Or Cells(i, 1) = "4.2" Or Cells(i, 1) = "2.32" _
Or Cells(i, 1) = "5.3" Or Cells(i, 1) = "12.1" Or Cells(i, 1) = "12.3" Or Cells(i, 1) = "12.9" Or Cells(i, 1) = "12.14" _
Or Cells(i, 1) = "12.15" Or Cells(i, 1) = "12.16" Or Cells(i, 1) = "12.17" Or Cells(i, 1) = "12.18" Or Cells(i, 1) = "12.19" _
Or Cells(i, 1) = "12.22" Or Cells(i, 1) = "12.25" Then
Добрый день. 3 монитора установлено. На главном двойной клик вызывает форму, переношу Excel на второй монитор - форма тоже вызывается, а на третьем не хочет Почему такое поведение? (Все мониторы разные - и по диагонали и по ориентации книжный и 2 альбомных) И форма улетает на разные места хотя в макросе Gigant позиционирована вроде
Добрый вечер! Есть функция открывающая диалоговое окно, При открытии показываются имена листов всех открытых книг и листы книги, которую нужно открыть, причем в диалоге уже стоит выбор на каком -то листе. Как не показывать листы всех открытых книг, а только выбранной и как сделать так чтобы в диалоговом окне не был выделен какой-либо из листов?
Код
Function ShowFileDialog() As Workbook
Dim oFD As FileDialog
Dim x, lf As Long
'назначаем переменной ссылку на экземпляр диалога
Set oFD = Application.FileDialog(msoFileDialogFilePicker)
With oFD 'используем короткое обращение к объекту
'так же можно без oFD
'With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Выбрать файлы" 'заголовок окна диалога
.Filters.Clear 'очищаем установленные ранее типы файлов
.Filters.Add "Excel files", "*.xls*;*.xla*", 1 'устанавливаем возможность выбора только файлов Excel
'.Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
.FilterIndex = 1 'устанавливаем тип файлов по умолчанию - Text files(Текстовые файлы)
.InitialFileName = ThisWorkbook.Name 'назначаем папку отображения и имя файла по умолчанию
.InitialView = msoFileDialogViewList 'вид диалогового окна(доступно 9 вариантов)
If oFD.Show = 0 Then Exit Function 'показывает диалог
'цикл по коллекции выбранных в диалоге файлов
For lf = 1 To 1 '.SelectedItems.Count
x = .SelectedItems(lf) 'считываем полный путь к файлу
Set ShowFileDialog = Workbooks.Open(x) 'открытие книги
'можно также без х
'Workbooks.Open .SelectedItems(lf)
Next
End With
End Function
Суть макроса сбор из файлов с одинаковой структурой в папке в словарь и вывод результата по неточному соответствию Пример файлы типа п1.xlsx, п2.xlsx, п3.xlsx находятся в одной папке с файлом макроса. Макрос собирает словарь все находящиеся файлы .xlsx из папки. Далее в файле с макросом в ячейке H1 при изменении значения например на 2 в диапазон A2:F вставляются значения, которые содержат 2 во втором столбце файлов .xlsx. Сейчас сущ. макрос делает это только по полному соответствию, а нужно чтобы выводил все цифры содержащие 2. Если в H1 поставить 4, то все содержащее четверку должно вывести
Есть код, который работает при небольшом количестве строк в книгах Книга СБ собирает последовательно файлы 1,2,3 лежащие в одной папке
Код
For Each Filename In coll
Set WB = Nothing: Set WB = Workbooks.Open(Filename, False, True)
If WB Is Nothing Then ' не удалось открыть файл
pi.Log vbTab & "ОШИБКА при загрузке файла. Файл не обработан."
Else ' файл успешно открыт
Set sh = WB.Worksheets("Сбор")
LastRow = WorksheetFunction.CountIf(sh.Range(sh.Cells(4, 2), sh.Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2)), ">" & 0) + 5
Set ra = sh.Range(sh.Range("a4"), sh.Range("b" & LastRow + 1)).Resize(, 36)
' ==== переносим данные в наш файл (shd - кодовое имя листа, куда помещаем данные)
shd.Range("a" & shd.Rows.Count).End(xlUp).Offset(1).Resize(ra.Rows.Count, ra.Columns.Count).Value = ra.Value
WB.Close False: DoEvents ' закрываем обработанный файл без сохранения изменений
pi.Log vbTab & "Файл успешно обработан."
End If
Next
Если строк в оригиналах в книге 5000 допустим, то обрабатываются все книги прогресс баром, а результат выгрузка только из первой открытой. Структура оригиналов такая же как и файлы 1,2,3. Не могу понять в чем причина. подскажите пожалуйста где ошибки
Dim Phone As String
Dim ReturnValue 'As нужен какой-то для приложения?
Phone = CStr(Cells(3, 2))
ReturnValue = Shell("C:\Users\*****\AppData\Local\Приложение.exe")
Application.Wait (Now + TimeValue("00:00:01")) 'Ждем, когда отработает приложение
ActiveWindow.Application.SendKeys ("{TAB 2}") 'Жмем tab 2 для перехода к номеру
Application.Wait (Now + TimeValue("00:00:01")) 'Ждем, когда отработает приложение
SendKeys (Phone), True 'Тут неожиданный результат
Формат номера: +7********** На выходе: &********** Вызываю повторно: На выходе: ?********** Иногда остается только 8 последних символов: ******** - После отработки надо включить NumLock постоянно выключает (Макрорекордер данное действие не видит) - Не понятно как переключаться между окнами (не работает AppActivate ReturnValue - как в примере отсюда Оператор SendKeys (VBA) | Microsoft Docs) - Application.Wait нужен ли вообще или Doevents можно?
Добрый день. Во вложении пример - выделяем все 3 листа через Ctrl и отправляем на печать в пдф (принтер адоб пдф) . Печатается первый лист. затем выводит диалог с предложением нового имени и после ввода имени печатаются остальные листы. Вопрос как это убрать чтоб печать в один файл производилась?
Добрый день! Допустим массив в примере на 12 строк. Как определить номера первого, второго и.т.д. наибольшего значения одной формулой В примере что-то выдумал, но перемешал порядок
Добрый день. Текст такого плана записан в ячейке C3 (отступы через Alt+Enter делались): АБВ ГДЕ ЖЗИ Текст в переменную:
Код
Dim a As String
a = CStr(Cells(1, 3))
ThisWorkbook.FollowHyperlink "https:***="& a
Далее вставляю в приложение через браузер (Edge) с помощью гиперссылки и все переносы пропадают АБВГДЕЖЗИ Что можно сделать в этом случае? Может есть какой-то знак, на который можно будет сначала заменить символ(10) и переносы осуществятся в браузере?
Формула выводит видимые строки столбца B Листа 1 на новый лист и подсчитывает их сумму Как обойтись в нижеприведенной конструкции без ДВССЫЛ("Скрыть!B"&СТРОКА(1:50))?- АльтернативаСМЕЩ (#2) Офис 365/21:
Может у кого есть время/желание/необходимые знания добавить склонение рублей и копеек и увеличить до 999 999 999 999.99 Формула работает до 999 999 999.99 без склонения рублей и копеек (2986 символов) Системный разделитель "."
Добрый день, подскажите как определить .Rows.Count без учета ячеек со строками нулевой длины или возвращающие 0 ' берем диапазон ячеек с ячейки A6 до последней заполненной в столбце B Set ra = sh.Range(sh.Range("a6"), sh.Range("b" & sh.Rows.Count).End(xlUp)).Resize(, 24) ' переносим данные в наш файл (shd - кодовое имя листа, куда помещаем данные) shd.Range("a" & shd.Rows.Count).End(xlUp).Offset(1).Resize(ra.Rows.Count, ra.Columns.Count).Value = ra.Value в ячейке B формула типа: =[****.xlsm]***!A144 До определенного момента возвращает формула цифры 1,2,3 далее пусто. Цифры взять, а ячейки нулевой длины не брать и не переносить на новый лист
Во вложении пример. Макрос с диалоговым окном вставляет в выбранную ячейку фото растягивая ее только по ширине не учитывая высоту Нужно Вставка изображений по имени из ячейки B из папки с файлом