Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 16 След.
Распарсить таблицу из текстового файла в Эксель
 
Отправил
Распарсить таблицу из текстового файла в Эксель
 
Добрый день.
Нужно распарсить таблицу из текстового файла в эксель, нужен макрос. Бюджет 2000 р. Исполнителю скину файл исходник и файл, что должно получится на почту.
Проблема с кодировкой при копировании данных из xml файла в эксель макросом
 
Проблема решена с помощью функции https://excelvba.ru/code/Encode
Проблема с кодировкой при копировании данных из xml файла в эксель макросом
 
Добрый день. Помогите пожалуйста, как можно решить проблему. Имеется макрос, который копирует данные из xml файла. При этом русские буквы переносятся, как иероглифы. Пример прилагаю. xml файл не могу приложить из за веса, даже с одной строчкой не дает.
Разделить текст по множеству делителей VBA
 
RAN,Спасибо, разобрался)
Разделить текст по множеству делителей VBA
 
Добрый день. Подскажите пожалуйста, вот есть у меня например текстовая строка "индекс1 что то индекс2 что то еще индекс3 какой то текст", слова индекс1 и.т.д. мне заранее известны, как можно разделить этот текст по определенным ячейкам в соответствии с этими индексами с помощью VBA? Пример во вложении.
Агрегирование таблицы с помощью VBA
 
Андрей VG, спасибо, сейчас разберемся.

Андрей VG, правильно я понимаю, что вот так должно выглядеть? Или есть проще решение со словарями?
Код
Dim dicTemp
Set dicTemp = CreateObject("Scripting.Dictionary")
For i = 2 To 5
    If dicTemp.Exists(CStr(Cells(i, 1))) = False Then
        dicTemp.Add CStr(Cells(i, 1)), Cells(i, 2)
    Else
        dicTemp.Item(CStr(Cells(i, 1))) = dicTemp.Item(CStr(Cells(i, 1))) + Cells(i, 2)
    End If
Next i
Worksheets("Результат").Cells(2, 1).Resize(dicTemp.Count) = Application.Transpose(dicTemp.Keys)
Worksheets("Результат").Cells(2, 2).Resize(dicTemp.Count) = Application.Transpose(dicTemp.Items)

Изменено: DopplerEffect - 12 май 2020 16:09:43
Агрегирование таблицы с помощью VBA
 
Добрый день. Помогите пожалуйста, есть таблица. Нужно вывести агрегированную информацию по этой таблице на другую вкладку. Знаю, как решить это с помощью SQL, но мне кажется с этим легко можно справится и средствами VBA. Как это можно написать без использования SQL запроса?
Код
[/CODE][CODE]Sub Макрос1()
Dim CON As Object 'New ADODB.Connection
Dim RS As Object 'New ADODB.Recordset
Dim arrS
Set CON = CreateObject("ADODB.Connection")
Set RS = CreateObject("ADODB.Recordset")
CON.Provider = "Microsoft.ACE.OLEDB.12.0"
CON.ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ActiveWorkbook.Name & "; Extended Properties=""Excel 12.0 Xml;HDR=YES"""
CON.Open
RS.Open "SELECT Артикул, SUM(Количество) FROM [База$] GROUP BY Артикул", CON
Worksheets("Результат").Range("A2").CopyFromRecordset RS
RS.Close
End Sub
Узнать серийный номер флешки через VBA
 
БМВ, правильно я понимаю, что для получения с помощью данной функции серийного номера устройства нужно имя диска. То есть у меня например флешка обозначается на устройстве, как F:, соответственно я прописываю:
Код
Function GetSerial(Optional ByVal DriveLetter$ = "F:") As String
Кстати забавно, я подключил жесткий диск и флешку и в случае жесткого диска ваша функция и функция, которая была здесь выдали одинаковый результат серийника. А вот с флешкой разные номера.

Но ваша функция соответствует информации в реестре, который выдает виндовс.
Изменено: DopplerEffect - 9 май 2020 09:03:01
Узнать серийный номер флешки через VBA
 
У меня выдал следующую информацию
USBsilicon-power USB Device\\.\PHYSICALDRIVE17,45E69B0400FFFF0D6[img]data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAooAAAASCAYAAADc3v+LAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAA07SURBVHhe7Zw7diI7EIbLdy0wgQ8raFYAThw5ddaEkDgjJHMCocmcOprEzQpgBRwH0+yF+1dJatRC6ofxA2N952hmGj1aKkmlUkk9V3tAkUgkEolEIpGIw3/670hLrq6uJEQiP4U4ZiMh4tj42cT+i3wGZlxFQzESiUQikUgk4iUaipFIJBKJRCIRL19rKO4W1L8a0Uo/Fhz9vqNFX7k8izCyckl6J15CnxY7neYsMe0yba17joRZ0Yj73B4XIfntkNYeT33EF+NEl+MGpAmPJX+ePuryMcPva8fBanRFthjdZ5ej+CbzsXbu6zb3Fx4ZKnn3D4Vp+VjBrpDvXW4dQw1cjRDv0SOh+jNu2Toc6gsCaUp9XLxDty9QR5a/xAXL5OCpa1UbfiLSV8dtL8ndh08Oriy94/CCQfvRcE/oI06n4X+M8Gx+t+WMvijyjFBWAaRclGUF6NeSgPn9GPPeOIN5hzPXg/mCcYE6cZCiPzsetK3bkS5ABm9f2L8jhGTZkrP0KK5GXZr0MuLvbFTIab4dOoozpayI1yHr0aR7QYow8gFg0b0f0tKMlzyjdLOk4b2zEKTWeNNpaseSlSfP5kTLIXUDi/s5M7hNafvvIA332cUfH5qPTTdvHRqvWe4Tuncy7BYzWiZzeh535LmZfrBgg6L7RtPa9BgrM4yUFPV+bNuPbvsz6k26jtFyLKMsxVg8Mkogi2mK8fTXM/5W9HeJkm4H+tkjdwlPZFIoYGx3J7TRTxfB4Knc5gwygzymepyEWD165JC/0cbWAesxeuEXAhlAAFZY83AEGKH9LtH2Tv2eQoKTR2WEsAE3xKCc54hD2E6Q1jYWgV0u9CtBv0JZ6kgUco88mNOSH9oaSkBFFSAN5maZqnwNyoROObRTB3vSfFp8g7rZ8tJry8FYRP5gX+DvJZ6lLxDXQ9nQwRJ3AmdoKLIiTGj+YEscivN5TolXcVoMbqEmtlSxxn0zvBiyInKVuKEuPtKenN5kVbgmTC2IeEBPmECVCwHSwBYCzcdSZzAmXttpOWtoGFXxxeOge0308nrQJe6zS128YfBA82RDb6wLG4G+wWK/gdIr5jl23qxT58+mv9rqBxhIWMTSzJalSe/01e6VXjYp3T5c1+uaWjxt8TB4QD02bxilDqLLlvTXzbz6i19RxxYDY7fo09XVkLZpSon+7fLw9bMHGDXDbXIkhxWs7+RaNETEB+aGWNd3N+r5iY2YJ55KRP+2+AMSveEHhDv8e/MSNk6gXzGEAfJxGlO2yD+Qnw0g0eMWVfmalPldtK0b1haRF/RVqW2+vsDmSQxEs1mShQyJG+tgP2doKHbpGovL0Y6+M6Z13cLJSjSdFjL6Pna0GLFy1kch1k6g+kjRE4+F0j42PZQFdqvye7CLOzpS7Y+sNP2KI8VD+lEofcX75DgM6c3CqxYnLs94S0zbdBouq2+VNbK9KqYufbyD4z/AS8yeKjTm8I4KUDf22lByp3RfQ9jTxpOyMIyCbfT3Mx99KQ/UO8ZBUJYN6NzQHb3Qq8nkPrvUxZ8CFJ142aR9kIOyEq053VI/hAwrSb8u6Yrd6wtt0lsaIG6KOsxOtfhP2riqzcrSsRTFoJk/VOtBlz9TyrF4rGEAXyrG61zaPxyB8YS1Nnu+08+GHWydBOvuty8c50v+pv7+45GR2okf+NPDHxXGCfQVO9FYv4px45Z9lB8TiL2JCQwqm6p8tWV+I++pm23wVfWFiyxkp3OGhiJ7UzJKl8Ni4fMfKWExMfEmYEd5DrvC3eKeJssNdrd7yucJbdAWbxNqgcHUndCyl4miz9lDgbKUMcFxQ7ynR1m+Jz4uvaMJDd3j0g12bQ9rbDIgUwy05azGiOAjgdtnpM/FG7QcGuOv+n1lI2lHry8Y1IzxlmAXJD+J8aXLQgmmrN5yQl33CA7p755P9awN6AF9wLDsumz8LjwGoz3eUDeMJEqnN6LH2qKOZavaiDGu3I+Fx0iMFLzTv1g1GAd1sqykQzfQ2S8HS9F5dqmL16weacIeuqLzPHPWcxw6eFLzv9/HPKLDkbOiqX6wSLQ3uZIVPbJNqi0NHs+bJl7TSpRRW+VRlWNQNk71s43MqZJnU3lTy2PEI1NHJp3BAFK7ZJS+SafVx8Wsl1/ufEa2OnV4uTfya3pd4gLBvIIArDtu+kjUeA3/WvfizBAzRozoAwRjnNg7JLtc6CspC/pVkLI9mPziTeT0joFfla+uzO/klLoVbQv0hQ1fCZCuQNoTzaKzvKPIi7scD0qwFoXSguC5m5PPiSb3ZzPJl7M+Pf55lsX96T2WjnhD0FKstKwAO/pOzpoXTh0n3gUVWRgfJU9I4RXjRQt/+Y65bGRXLgXq8vRCV/c+8Z7giS0fYxQKyhhShhBXB8aXKQv/NmWJMbdxvFQtPXohOuO1GFfcfG7PcgKD0TWk7PtJhZHcfaeBD+raaMtLL3TB9jYZB3WyrKGjLL9CJu6zy3G8b+O2pXluG/n+Oav6xUYf20IkhyNnmyb6oSUsR1v+3D+bCbW+qljJsYxm1zntQ8pBju6t42e3jkLgjuK7FM4PRfRN3XE8NgIvd86mQ7P7x4egelPKYUpvv/Wuu3tHcT3WEQxr8Cl+x4LA9+KG+u4bH3fOoc0msEau7vHD8Ywul4v80K8E/VovZCSQ+4/PJxs7R2B+YxIegjGKDZ8dfxKBvjDwxzIsNyZFOs+wb8OZGoo2elHgBaXu/lfnD/WMYfONdMZTSnmuYKVjY6PLx79V9Q6wC+08gInrNXE/nwh7yOrfp+/1sQckf1NG4Zy9mMoYUh5GddHclLWBYjELZnfC8Z/Xd2xcrTGpMig0UWOVRoAxko13sB0so/o2WvLShrUY0Rzl0GQcnCxLnjv2JsJ9djmK9xks5aPdVnSv0U+9BqcrDfRD3eYIGpY/YuEx0dUy5Dt9rGbdo992sKcqUVeRBEtG2kCunr/suU2KOsixc2CM/GaKKwP62cdqNMS6GvA4eq4htLmf/CuQ41Eg1jgEZbyIZmKN9d04/vjlVqcNjm38rvWrCNmU7cL5+a4AryI+RVKVryrO4H5sUjKKwWfFN6lbCLttob5gI7ELI1VA3AdsGr/WUBRDzjMB2bAwx0P8haLvThrfi6o5xlHYivm7wOK13lOeZ9hoYTngL2jf4ZrohAYUMHHvMWQEkbNeFF3vmgMvZk3ep46ftzSTr9P4iEwbQ9uZ8jBqZW7KSuY55o8xKlRoPaa3/yrrXqZDAyi0Z30U/dHwQm7GX5M2KnktaXZfdezcbBycLkvuK/vjCffZpS7+k2irH0IfhaAEvgcrTkjtkfJ6O0/5OEm8vQFjl42TDDUrrnb4Yc+tfFgD5T9b1n/R+xvJ3zB7KpW+unO8HGp9J9cdlHf3FCf0r4I/YGuKbF6hY9uuw2ZtKfLjWRYOdB76qjB++Bjb7rijfOpRqIr7btrUTa8tkqayL1Am3+sWkD6HAf8BfLFHkReXDU1K/zUJFDbfLTQ7ZX3c4v6XEXLvj6ovK6sLzR9zXHkK6kOOPr2iveMHKHr89q67k+Z40twr1Mad3E3TcfJVJUfyBw1ioDVcTPTxpQTsdIoc4mmTAovyZOPS5H3iBdrIkaE5RhVjCD8oO7GwkFRZL6/6Yxi8q/VHK9oILeoLzJG37V0wBjEUi0pl7k9WHVXtCqOv8QV3Wcjxt/mYqkkbZayzeFCfqnHbZBycJEsF95XtQXOfXeriP4XW+kEdxZcNMpbRsPj4IXhPUD5q2dTfxfSi9dq84sMTzMHsSB86iAGsNxM1XrPfCX+IUueZta8q6A0AZg1vDGQz5W4++Cj6DNaRswLjUBYyM99tw2W1UIacTDAE1q+Vx51IY/LLIvGgypZdns4P+VMHcWvLI4d+E/gYmzsumA+PVXHfTdu6sYdQry2SprIvrK/DM/NfG30AmDhfDjbS6PVDSOa5jjngpoHG3Rep8vkeYinHS0j3mPxfgnmnn3w/T5MiTZKauuP3xK5n3TNAW1P5zZSV6bJAnpXfAxllRWS2hwFhyc1TdgmTPrXKTPalrql8H2PeYfVp0VfOe1GW3S5+b7juIXKMk0N95L22fDT5PC2PF26j+66jkOxRVABfngRtdt5d2UZFPlf1L7+r/Tioew9j4sNwu+x+OjzzfDyepzpe+tjO5yGUpu3vmnr94OTN0nL6QuDcBmec20g+lCVlWvl1EJkE4kp9GmwPvx/pOXEoja57eYyAwHtN8Kf3y9Tk+XmE+88/ZoFHDmYequCX0Tlzcv9BJijAHwph4B/QM+r3xPodQA8X6bHeHUAi83spOPn5/aZs6K8jJc6YOtoDuypfME7XCTrDz2fHg7q6lQJkhbWlDJ59fYExf5wfIajgqjHj6ko/RFrCHh3mcsTHR3HKy5LbHsbIxXB5YzbyUVzk2NgtaPR6Q0+/4Lg+zu3IZ2DG1Q/4mCUSiUQikXbsXt/oOp4fRyInEw3FSCQSiVwcnfHT+7+6j0QiBXL0bNyLkUgkEolEIpGIguh/DC4MmRdwQocAAAAASUVORK5CYII=[/img]
Узнать серийный номер флешки через VBA
 
У меня код Игоря выдает одинаковые цифры не зависимо от того, какие устройства подключены или нет. А код Hugo не запустился
Узнать серийный номер флешки через VBA
 
Добрый день.
Вроде не было подобного вопроса, можно ли узнать средствами VBA серийный номер (тот что закладывается производителем и обеспечивает уникальность) флешки? Файл с макросом будет находиться также на флешке.
Подскажите пожалуйста.
Изменено: DopplerEffect - 8 май 2020 13:33:04
Защита макроса по времени использованию и компьютеру
 
Добрый день.
Знаю, что Эксель считается не очень защищенной программой, но все же минимальную защиту от обычных пользователей хотелось бы научится делать. Помогите пожалуйста с информацией.
Задача, допустим есть файл с каким либо макросом. Можно ли каким то образом ограничить время использования данного файла на компьютере, например предоставил пользователю файл, он с ним провел какие то действия по установке и соответственно с этого момент начинает исчисляться 7 дней пользования. Далее макрос в файле запускаться не должен, повторная установка также не должна снимать защиту.
И второй вопрос, каким образом можно разрешить использование программы макроса на конкретном компьютере, то есть установили один раз файл на компьютер и на других он уже работать не должен.

Буду благодарен за любую информацию и нестандартные решения.
Ошибка при копировании листа Path/File access error...
 
Перенесите пожалуйста тему в платный раздел, исполнителю вышлю файл с макросом. Готов оплатить 1000 р. за консультацию как избавиться от этой ошибки и в чем ее причина. Могу подробно по телефону рассказать по действиям.
Изменено: DopplerEffect - 7 апр 2020 16:58:36
Ошибка при копировании листа Path/File access error...
 
Добрый день. Помогите пожалуйста разобраться.

Выполняю код макроса, который последовательно открывает и копирует информацию из нескольких книг, потом обновляет сводные. После этого при попытке скопировать лист книги в новую книгу возникает ошибка Path/File access error (причем данная ошибка возникает и как при ручном копировании, так и при попытке скопировать макросом, валится на строке Sheets.Copy).
Самое интересное, что если сохранить файл, выйти из него и зайти снова, то при копировании уже ошибка не возникает.

Что означает данная ошибка, в чем причина может быть?
Изменено: DopplerEffect - 6 апр 2020 17:31:46
В сводной таблице есть поле, которого нет в исходной
 
Спасибо, помогло)
В сводной таблице есть поле, которого нет в исходной
 
Добрый день.
Помогите пожалуйста, есть сводная таблица, в ней есть поле "Поз/час расч", в исходной таблице этого поля нет. Как определить откуда оно и как считается? Файл прилагаю.
Выровнять таблицу по высоте средствами VBA
 
gling,получилось, спасибо большое!
Выровнять таблицу по высоте средствами VBA
 
Андрей VG, создал пример, убрал все лишнее. На листе "Протоколы" указываем путь к вордовскому файлу. Далее запускаем макрос и в Ворд копируется таблица. Задача оптимизировать высоту ячеек под текст в таблице на листе Ворда. Посмотрите пожалуйста.
Выровнять таблицу по высоте средствами VBA
 
Андрей VG, Спасибо, немного изменил, так как ваш вариант выдал ошибку, а вот так отработало:
Код
objDoc.Tables(1).Rows.HeightRule = wdRowHeightAuto

К сожалению глобально проблему не решило, в Вордовской таблице по прежнему почему то пустоты в строках между текстом и границами.
Выровнять таблицу по высоте средствами VBA
 
Андрей VG, Еще раз. Есть файл Эксель, в нем находится макрос и таблица. Я запускаю макрос, он копирует данную таблицу и вставляет ее в файл Ворд, но вставляет ее криво. Мне нужно, что бы эта таблица в ворде выровнялась по ширине и высоте. Для ширины я нашел решение в виде:
Код
objDoc.Tables(1).AutoFitBehavior (2)
После чего ширина подгоняется под размеры листа в ворде, а вот с высотой не знаю как сделать, что бы высота строк автоматически подгонялась.
Изменено: DopplerEffect - 29 янв 2020 15:01:11
Выровнять таблицу по высоте средствами VBA
 
Андрей VG, а это точно должно работать в ворд, таблица то в ворде находится, но запускаю я метод из экселя?  
Выровнять таблицу по высоте средствами VBA
 
Добрый день. Есть таблица в Эксель и макрос. Я макросом копирую данную таблицу в Ворд, далее с помощью метода Tables(1).AutoFitBehavior (2) подгоняю таблицу в документе ворд по ширине. Подскажите пожалуйста аналогичный метод, что бы выровнять таблицу по высоте строк?
При копировании ячейки без заливки из эксель в ворд появляется цветной фон
 
Hugo,че т волшебство какое то, я только что попробовал и тоже без заливки, хотя час мучался...Ладно ,если всплывет еще раз постараюсь отправить без изменений файл.
При копировании ячейки без заливки из эксель в ворд появляется цветной фон
 
Добрый день!
Помогите пожалуйста, во вложении пример ячейки, она без заливки, цвет текста черный. Я эту ячейку копирую и вставляю в пустой файл Ворд и текст при этом копируется с желтой заливкой. Что это за невидимый формат такой? В первые сталкиваюсь. Как можно убрать это?
Ускорить работу макроса
 
Добрый день!
Есть небольшой макрос, который считает рабочее время. Суть в том, что там очень много раз проходит он по циклу и из-за этого скорость обработки данных низкая. (в файле 1000 строк обрабатывает в течение 1.5 минут, ожидается что в файле будет около 20000 строк и время обработки должно быть более менее адекватным). Я так подозреваю, что это можно вообще решить без циклов, но к сожалению не могу сообразить как. Если кто возьмется помочь, то я могу более подробно рассказать по задаче макроса и тому как сейчас работает. Код прилагаю тут ,файл вышлю исполнителю.

По бюджету 1000 р.
Код
Sub Рассчет()

a = Timer
Application.ScreenUpdating = False

Range(Cells(2, 18), Cells(1048576, 19)).ClearContents

n = Cells(Rows.Count, 7).End(xlUp).Row
n3 = Лист3.Cells(Rows.Count, 4).End(xlUp).Row

Начало_дня = Лист3.Cells(2, 2)
Конец_дня = Лист3.Cells(3, 2)
Начало_обеда = Лист3.Cells(4, 2)
Конец_обеда = Лист3.Cells(5, 2)

Праздники = Range(Лист3.Cells(1, 4), Лист3.Cells(n3, 4))

Массив = Range(Cells(1, 1), Cells(n, 9))



For i = 2 To n
    If Массив(i, 9) = "Выполнен" Then
        Cells(i, 18) = Массив(i, 7)
    Else
        Дата = Массив(i, 7)
        For i2 = 1 To 1440
            Дата = Дата - (1 / 1440)
            If DatePart("w", Дата) = 7 Or DatePart("w", Дата) = 1 Then
                i2 = i2 - 1
                GoTo metka
            End If
            For i3 = 2 To n3
                If DateSerial(Year(Дата), Month(Дата), Day(Дата)) = Праздники(i3, 1) Then
                    i2 = i2 - 1
                    GoTo metka
                End If
            Next i3
            If TimeSerial(Hour(Дата), Minute(Дата), Second(Дата)) > Конец_дня Or TimeSerial(Hour(Дата), Minute(Дата), Second(Дата)) < Начало_дня Or (TimeSerial(Hour(Дата), Minute(Дата), Second(Дата)) >= Начало_обеда And TimeSerial(Hour(Дата), Minute(Дата), Second(Дата)) <= Конец_обеда) Then
                i2 = i2 - 1
                GoTo metka
            End If
            
metka:
        Next i2
        Cells(i, 18) = Дата
    End If
    

    If Массив(i, 8) >= Cells(i, 18) Then Cells(i, 19) = Int(DateDiff("n", Cells(i, 18), Массив(i, 8)) / 60) & ":" & Int((DateDiff("n", Cells(i, 18), Массив(i, 8)) / 60 - Int(DateDiff("n", Cells(i, 18), Массив(i, 8)) / 60)) * 60)
Next i
Application.ScreenUpdating = True
MsgBox Timer - a
MsgBox "Готово"

End Sub



Оптимизировать работающий макрос под Мак
 
Добрый день!
Есть файл Эксель с макросом. Этот файл работает нормально на виндовсе, но на Маке выдает ошибку. Я подозреваю, что дело в русском наименовании объектов и переменных, но может быть и еще причина в чем то. Задача сделать так, что бы работало на Маке.

Бюджет 3000 р.
Сохранение CSV файла макросом
 
Дмитрий(The_Prist) Щербаков, Спасибо, все заработало)
Сохранение CSV файла макросом
 
Добрый день!
Записал макрокодером сохранение CSV файла, получилось так. Проблема в том, что при запуске макроса и повторном открытии этого файла он открывается с разделителями, а не в виде классической таблицы. Но если сохранять руками, то все нормально. В чем может быть причина подскажите пожалуйста.
Код
ActiveWorkbook.SaveAs Filename:=Путь & "\" & Имя & ".csv", _
        FileFormat:=xlCSV, CreateBackup:=False

Изменено: DopplerEffect - 15 ноя 2019 10:57:08
При разделении данных по символу автоматический перевод числа в экспоненциальный вид
 
БМВ, ппц вот уж не знал, что там можно столбцы нажимать еще, я думал формат определяется целиком для всех столбцов, выбирал текстовый оказывается только на первом))
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 16 След.
Наверх