Импорт данных в excel макросы - Word и Excel - помощь в работе с программами

Chelovek

Пользователь

Сообщений: 25
Регистрация: 21.04.2018

Здравствуйте, уважаемые форумчане.
Нужен небольшой макрос импорта данных из текстового файла в активный лист Excel.
Перебрал много разных предложений в интернете. Но каждый раз макрос делает что-нибудь не так как надо.

Исходные данные (прикрепляю):
Текстовый файл «Текст.txt» содержит строки с буквами, цифрами, пробелами и др. знаками.
Файл Excel «Таблица.xlsm» содержит Лист1 с кнопкой макроса (там же показано — Как должен выглядеть Столбец A по завершении работы).

В процессе своей работы макрос должен:
1-Открыть проводник (диалог), позволяющий найти файл «Текст.txt»;
2-Открыть ТЕКУЩУЮ (!) папку (где находится файл Excel, а не где-нибудь в дебрях ПК);
После того как выберем файл «Текст.txt»
3-Не открывать его как временный файл Excel, а СКОПИРОВАТЬ (!) с него данные.
4-Вставить эти данные в активный Лист1, начиная с ячейки A1 с таким условием:
5-1-я строчка txt = ячейка A1 Листа1
6-2-я строчка txt = ячейка A2 Листа1 и т.д.
7-Должны заполниться ячейки только из столбца A. Все остальные столбцы не задействуются.
8-Строки не должны разрываться.
9-Слова или цифры не должны слипаться. Пробелы между словами не должны исчезнуть.

Спасибо всем, кто откликнется!

Msi2102 Пользователь Сообщений: 3137 Регистрация: 31.03.2014	С таким ТЗ Вам скорее всего в платный раздел

New Пользователь Сообщений: 4581 Регистрация: 06.01.2013	Chelovek, потестируйте файл

Chelovek Пользователь Сообщений: 25 Регистрация: 21.04.2018	New, Проверил. На этом и на других файлах. Всё работает в точном соответствии с поставленными условиями. Очень благодарен. Я оставлю вам сообщение в личке.

Евгений Смирнов

Пользователь

Сообщений: 539
Регистрация: 18.02.2021

31.01.2022 18:20:56

Цитата
Chelovek написал: Нужен небольшой макрос импорта данных из текстового файла в активный лист Excel.

Самый самый небольшой макросик, который смог за сегодня найти на бескрайних просторах интернета.(Весь день искал даже на обед не пошел)

Код

Sub enstaralgkl()
    Dim FileName$, Arr1
FileName = "Текст.txt": FileName = ThisWorkbook.Path & "" & FileName
    Open FileName For Input As #1: FileName = Input(LOF(1), #1)
    Arr1 = Split(FileName, vbNewLine): Reset
Range("A1").Resize(UBound(Arr1)) = WorksheetFunction.Transpose(Arr1)
End Sub

Функция открытия диалогового окна есть в файле NEW

Chelovek Пользователь Сообщений: 25 Регистрация: 21.04.2018	Евгений Смирнов Ваш код работает. Впечатляет Ваш профессионализм. Большое спасибо за помощь! Если что — буду обращаться к Вам.

New

Пользователь

Сообщений: 4581
Регистрация: 06.01.2013

01.02.2022 00:00:16

Евгений Смирнов, Евгений, т.к. массив после Split создаётся с нулевым индексом, то у вас не выгружается на лист последняя строка (Ярославль_609_610_100,16%). Надо добавлять +1 при выгрузке на лист

Код
Range("A1").Resize(UBound(Arr1) + 1) = WorksheetFunction.Transpose(Arr1)

P.S. Так же, я надеюсь, вы знаете ограничения связанные с Transpose? На примере от ТС это не критично, но кто знает, какие реальные файлы у ТС в работе

Изменено: New — 01.02.2022 00:02:35

Chelovek: Спасибо за оценку моего скромного труда, но до профи мне далеко, как до Китая пешком. (Просто в некоторых вопросах, которые меня интересуют, стараюсь до конца разобраться)

New: Здравствуйте. В вашей функции CountLinesInTextFileFast надо добавлять +1 т.к. она считает количество строк в файле. В моем не надо. И вообще зачем вы 2 раза читаете текстовый файл. Первый раз чтобы посчитать кол-во строк, а второй, чтобы заполнить массив. Это все можно сделать за одно считывание (В данном случае). Про ограничение Transpose знаю, уже натыкался. Это легко обойти добавить цикл.(Сделать свою Transpose)

МатросНаЗебре

Пользователь

Сообщений: 5516
Регистрация: 05.02.2014

01.02.2022 09:45:40

Цитата
написал: мне далеко, как до Китая пешком

Жители Благовещенска никак не могут понять, является ли Евгений профи или нет )

UPD Этот край упомянул из-за близости к Китаю. Я сам не из этих мест.

Изменено: МатросНаЗебре — 01.02.2022 12:14:00

МатросНаЗебре Привет жителям Благовещенска, почти земляк. Но мне подальше до Китая, чем вам. А к профи не отношусь. Если узнаете о моей профессиональной деятельности будете сильно удивлены. (Никогда не занимался программированием профессионально это честно без шуток)

МатросНаЗебре А я подумал сибиряк значит земляк. Обманули меня.

Изменено: Евгений Смирнов — 01.02.2022 14:16:08

New

Пользователь

Сообщений: 4581
Регистрация: 06.01.2013

#11

01.02.2022 11:20:33

Цитата
Евгений Смирнов написал: В моем не надо.

Евгений, терять часть данных (последнюю строку) при импорте данных — не очень хорошая вещь.
Или вы мне не верите, что ваш код не переносит последнюю строку из текстового файла в Excel?

New Павел как ни странно у меня все нормально отрабатывает. вроде я текстовый файл из темы не правил. сейчас еще попробую скачать заново

PS New Вы правы надо добавить +1. С файлом который в теме все нормально, но там последняя строка пустая. Если ее удалить, то последняя не выводится.

Изменено: Евгений Смирнов — 01.02.2022 11:39:23

юнат

Пользователь

Сообщений: 22
Регистрация: 18.10.2022

Здравствуйте.
В целом моя проблема в незнании VBA.
А одна из проблем — копирование данных из текстового файла в ексель автоматически.
В приведённом выше примере данные копируются по нажатию кнопки, а можно ли запускать
макрос по изменению текстового файла, и копировать только последнюю строчку из него?
Скажите есть ли такая возможность?

	Можно отслеживать дату сохранения текстового файла. Если она меняется, считывать последнюю строчку. Отслеживать можно или периодическим макросом, или каким-нибудь, например, Worksheet_SelectionChange.

Ігор Гончаренко

Пользователь

Сообщений: 13746
Регистрация: 01.01.1970

#15

18.10.2022 13:56:52

Код

Sub TestRLL()
  MsgBox "<" & ReadLastLineFrom("d:igorf1.txt") & ">"
End Sub

Function ReadLastLineFrom$(FileName$)
  Dim fso, Txt, s$, p&
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set Txt = fso.OpenTextFile(FileName, 1)
  s = Txt.ReadAll:  Txt.Close: Set fso = Nothing
  ReadLastLineFrom = Right(s, Len(s) - InStrRev(s, vbLf))
End Function

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

юнат Пользователь Сообщений: 22 Регистрация: 18.10.2022	Ігор Гончаренко, спасибо! Буду разбираться куда енто прикрутить.

Ігор Гончаренко

Пользователь

Сообщений: 13746
Регистрация: 01.01.1970

#17

18.10.2022 14:22:52

код нужно скопировать в стандартный модуль
а пользоваться можно вплоть до того, что в А1 написать полный путь к файлу, а, например, в А2 написать

Код
=ReadLastLineFrom(A1)

юнат

Пользователь

Сообщений: 22
Регистрация: 18.10.2022

Код работает, только когда вручную запускаешь макрос. И данные не записываются в ячейку.
Сообщение с нужным текстом данных выводиться. Отключите пожалуйста функцию сообщения.

В Текст.txt у меня приходят данные со считывателя рфид карт автоматически, с помощью дополнительной
программы читающей ком порт. Но даже если ввожу данные вручную, то код тоже нужно запускать вручную.

Изменено: юнат — 19.10.2022 09:36:28

пока условия вашей задачи известны только вам одному — вам самому ее и решать
когда сможете обьяснить условия задачи для всех — может кто-то подскажет как ее решить

юнат Пользователь Сообщений: 22 Регистрация: 18.10.2022	Ігор Гончаренко, благодарю за помощь! Раз из текстового файла сложно записывать, спрошу в ветке импорта данных из ком порта сразу в ексель.

что сложно?
я написал вам функцию которая возвращает последнюю строку из текстового файла. пользуйтесь, записывайте полученную строку куда угодно, где и что тут сложно?

юнат

Пользователь

Сообщений: 22
Регистрация: 18.10.2022

Ігор Гончаренко, для меня всё непонятное — сложно.
Я думал/хотел чтоб макрос сам работал, автоматически, при изменении данных в Текст.txt.
А он запускается только принудительно, выдаёт значение только в сообщении и не записывает
данные в ячейку екселя.
Для моей задачи можно, допустим, чтоб раз в секунду макрос проверял
изменение файла Текст.txt., и если да, то автоматически копировал последнюю строчку в ексель.
В екселе у меня простенький макрос, который «узнаёт» длинный номер карты и меняет
его на простой десятичный номер.
Может у меня с настройками/надстройками екселя что то не правильно и поэтому ваш макрос не вводит значение в ячейку ексель?

юнат

Пользователь

Сообщений: 22
Регистрация: 18.10.2022

У меня задача читать рфид карты и преобразовывать их длинный номер в десятичную цифру (например 01004C11BBE7 = 57).
Человек подносит карту к считывателю, который подключен к ком порту компа, и с момента считывания
карты все преобразования должны быть выполнены автоматически.

а для меня сложно угадывать что думает другой человек, особенно если он об этом только думает, но ничего не говорит (не пишет)
вы не обязаны знать VBA
но если не знаете настолько, что не знаете как вместо
MsgBox «<» & ReadLastLineFrom(«d:igorf1.txt») & «>»
(демонстрация результата работы функции ReadLastLineFrom в окне сообщения)
результат работы этой функции положить в ячейку, то это просто:
[a1] = ReadLastLineFrom(«d:igorf1.txt»)
это все. результат в ячейке А1, если нужна строка как положить результат в другую ячейку — пишите в какую, напишу вам код))
и
относительно глобальной задачи: кто-то же когда-то пишет данные в текстовый файл?
он может записать эти же данные и в нужную вам ячейку и не нужно ничего проверять раз в секунду, потому что за секунду в компьютере проходят тысячи событий и в вашем файле пока вы ждали секунду может оказаться 10 добавленных строк и вы получите только последнюю из них, а 9 уже похоронено в недрах файла
и…
бесполезно писать советы человеку, который не может изменить двух байт в коде, поможет только полностью работающий код (желательно сразу в файле, чтобы случайно не был скопирован не туда или не продублирован рядом с прошлым, что приведет отказу компилятора такое «исполнять»))
и…
это все перестает иметь хоть какое-то отношение к обсуждаемой тут теме. формулируйте свои вопросы в отдельных темах, не нужно эту тему превращать в мусорку для всего подряд

Изменено: Ігор Гончаренко — 20.10.2022 09:47:50

Jack Famous

Пользователь

Сообщений: 10848
Регистрация: 07.11.2014

OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome

#25

20.10.2022 09:45:00

Порадовал)))

Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄

юнат

Пользователь

Сообщений: 22
Регистрация: 18.10.2022

Ігор Гончаренко, я только добавляю исходные данные, а вы уже ругаетесь что это мусор, в то же время пишите что я ничего не говорю.
А тема у меня не поменялась — «Макрос импорта строк из txt-файла» с уточнением: «автоматически», пытаюсь соблюдать правила форума, не плодить лишнего.
Если для этого нужна отдельная тема, извиняйте, не знал.
Спасибо за макрос — заработал, жаль что не автоматически. И условие 1 раз в секунду меня полностью устраивает, но при условии что txt файл был изменён для исключения постоянного вывода данных раз в секунду.
Прога что записывает в txt файл не хочет записывать в ексель, она триал-версия, я ей пользуюсь для наладки, хотелось бы в дальнейшем сразу из ком порта читать в ексель. Но пока все хотелки разом не реализовать, вот и пытаюсь постепенно выстраивать рабочую цепочку. До решения всей задачи мне как от Калининграда, вам как от Благовещенска до Китая пешком.
Чтоб вы понимали мой уровень владения компьютером, я наморщил лоб чтоб узнать путь C:UsersParkingDesktopТекст.txt
Да-да, бывают и такие люди.
Не Программисты — это люди, решающие проблемы, о существовании которых Программисты не подозревают, методами, которые Программисты не понимают! (есть и такая философия)))

читайте название темы, подумайте о чем это
как импортировать строки из текстового файла уже выясненно
после вашего уточнения выяснено даже как импортировать одну последнюю строку: ReadLastLineFrom(…)
а вот в каком месте и при каких обстоятельствах (как часто) нужно это делать — можно выяснить только у вас и это не имеет НИКАКОГО отношения к обсуждаемой тут теме

Изменено: Ігор Гончаренко — 20.10.2022 12:30:27

юнат Пользователь Сообщений: 22 Регистрация: 18.10.2022	Ігор Гончаренко, большое спасибо за помощь, почти все свои задачи решил, осталась только до ком порта достучатся. Так же благодарю МатросНаЗебре, за Worksheet_SelectionChange, прикрутил кое как, работает.

юнат

Пользователь

Сообщений: 22
Регистрация: 18.10.2022

#29

20.12.2022 18:32:14

Хелп ми! Поломалось! Не работает!
А как хорошо работало.

Код

Function ReadLastLineFrom$(FileName$)
  Dim fso, Txt, s$, p&
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set Txt = fso.OpenTextFile(FileName, 1)
  s = Txt.ReadAll:  Txt.Close: Set fso = Nothing
  ReadLastLineFrom = Right(s, Len(s) - InStrRev(s, vbLf))
End Function

Если курсор в текстовом файле спрыгивает на следующую пустую строчку, то этот вакуум копируется в ячейку ексель.
Подскажите как не копировать пустую последнюю строчку, а подняться на строчку выше, или предпоследнюю строчку со значением?

New

Пользователь

Сообщений: 4581
Регистрация: 06.01.2013

#30

20.12.2022 19:51:31

попробуйте так

Код

Function ReadLastLineFromTXT(FileName As String) As String
    Dim FSO As Object, TxtFile As Object, str As String, pos As Long
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FileExists(FileName) Then GoTo ExitMark:
    Set TxtFile = FSO.GetFile(FileName)
    If TxtFile.Size = 0 Then GoTo ExitMark:
    Set TxtFile = FSO.OpenTextFile(FileName, 1)
    str = TxtFile.ReadAll
    pos = InStrRev(str, vbLf)
    ReadLastLineFromTXT = Right(str, Len(str) - pos)
    If ReadLastLineFromTXT = "" Then
        Do While ReadLastLineFromTXT = ""
            pos = InStrRev(str, vbLf, pos - 1)
            ReadLastLineFromTXT = Right(str, Len(str) - pos)
            ReadLastLineFromTXT = Replace(ReadLastLineFromTXT, vbCrLf, "")
        Loop
    End If
    
    TxtFile.Close
ExitMark:
    Set TxtFile = Nothing
    Set FSO = Nothing
End Function

Изменено: New — 20.12.2022 20:11:14

Источник

Нет, ну ты видел?!

8 / 8 / 0

Регистрация: 21.05.2020

Сообщений: 146

31.08.2020, 08:17. Показов 10678. Ответов 74

Здравствуйте,
Есть файл txt_01.txt, из него необходимо скопировать содержимое
Содержимое столбцами расположено, примеру так

15rt63 174asd94 39047 494 39a049 0304
157863 174394 39047 4a94 39049 0304

1a57863 1asd394 390ds47 494 390a49 0304
15d7863 174394 39047 494 39dsd049 0304

157863 17asd394 39047 494 39049 0304
157863 174d394 3904a7 494 39049 0304

Нужен макрос, который бы скопировал всё и вставил также по столбикам с первой ячейки первой строчки в определенный лист excel файла

Листая интернет, я нашел много ссылок на такие макросы, но почему то они у меня не работают. Я их слабо понимаю, и видимо одной замены расположения txt файла недостаточно, помогите :/
Спасибо

Programming

Эксперт

94731 / 64177 / 26122

Регистрация: 12.04.2006

Сообщений: 116,782

31.08.2020, 08:17

Ответы с готовыми решениями:

Импорт txt в excel
Добрый день! Есть макрос, который импортирует txt файл в excel, подскажите, пожалуйста, как…

Импорт txt в excel
Добрый день!
Если кто-нибудь знает, подскажите, пожалуйста, как решить данную задачу: у меня есть…

Импорт txt в Excel
Здравствуйте! Имеется txt документ. Нужен макрос, которы будет конвертировать информацию из него в…

Импорт из Excel или Txt в БД Лотус
Вроде тема поднимлась так или иначе, но то что нужно не нашла.
Пожалуйста, поделитесь скриптом,…

Часто онлайн

792 / 530 / 238

Регистрация: 09.01.2017

Сообщений: 1,820

31.08.2020, 09:51

blackfisk, Какой разделитель между блоками?
Где файл?

Narimanych

2630 / 1636 / 744

Регистрация: 23.03.2015

Сообщений: 5,142

31.08.2020, 09:52

blackfisk,

Visual Basic

Sub MMM()
        FL = Application.GetOpenFilename("Excel files(*.txt*),*.txt*", 1, "Âûáîð òåêñòîâîãî ôàéëà", , False)
            If VarType(FL) = vbBoolean Then Exit Sub
               
        Workbooks.OpenText Filename:=FL, _
            Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=True, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=True, _
            Other:=False, TrailingMinusNumbers:=True, _
            Local:=True
 
End Sub

blackfisk

Нет, ну ты видел?!

8 / 8 / 0

Регистрация: 21.05.2020

Сообщений: 146

31.08.2020, 10:05

[ТС]

Сообщение от Narimanych

blackfisk,

Visual Basic

Sub MMM()
        FL = Application.GetOpenFilename("Excel files(*.txt*),*.txt*", 1, "Âûáîð òåêñòîâîãî ôàéëà", , False)
            If VarType(FL) = vbBoolean Then Exit Sub
               
        Workbooks.OpenText Filename:=FL, _
            Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=True, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=True, _
            Other:=False, TrailingMinusNumbers:=True, _
            Local:=True
 
End Sub

Спасибо
Но получается не очень, числа слипаются в одну ячейку в excel

Возможно я неправильно объяснил, между числами может быть больше одного пробела
К тому же макрос создает отдельный лист, а нужно открывать и в уже имеющемся листе документа, в котором и располагается кнопочка с макросом,
Наверное лучше показать исходный вид txt файла
Это только один из кучи разных txt с разными «размерностями» столбцов

Что то слепилось у меня, но он также не распределяет нормально числа по ячейкам

Visual Basic

Sub macro()
Dim a, i&, tmp
a = Split(CreateObject("Scripting.FileSystemObject").Getfile("D:...1.txt").OpenasTextStream(1).readall, vbNewLine)
For i = 0 To UBound(a)
a(i) = Replace(a(i), """", "")
tmp = Split(a(i), vbTab)
Cells(i + 1, 1).Resize(1, UBound(tmp)) = tmp
Next
End Sub

Миниатюры

2630 / 1636 / 744

Регистрация: 23.03.2015

Сообщений: 5,142

31.08.2020, 10:15

blackfisk,

Сообщение от blackfisk

Наверное лучше

прикрепить текстовый файл….

Нет, ну ты видел?!

8 / 8 / 0

Регистрация: 21.05.2020

Сообщений: 146

31.08.2020, 10:44

[ТС]

Извините, вот txt

КостяФедореев

Часто онлайн

792 / 530 / 238

Регистрация: 09.01.2017

Сообщений: 1,820

31.08.2020, 11:01

blackfisk,

Visual Basic

Sub tyyy()
 ChDir "C:UsersadminDesktop"
    Workbooks.OpenText Filename:="C:UsersadminDesktoptxt3.txt", Origin:= _
        1251, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=False, _
        Space:=True, Other:=False, _
        TrailingMinusNumbers:=True
End Sub

Так?

Добавлено через 1 минуту
если заголовки не нужны поменяйте на три

Visual Basic

1	StartRow:=1

Нет, ну ты видел?!

8 / 8 / 0

Регистрация: 21.05.2020

Сообщений: 146

31.08.2020, 11:08

[ТС]

Да, спасибо, но о5 же, макрос создает отдельный excel файл, но необходимо открыть внутри уже имеющегося файла на новом листе, или определенном листе, главное, что в самом файле, из которого запущен макрос

Макрос запускается по нажатию кнопки в excel файле

Catstail

Модератор

34707 / 19228 / 4039

Регистрация: 12.02.2012

Сообщений: 32,190

Записей в блоге: 13

31.08.2020, 11:14

blackfisk, у тебя данные «грязные», разделитель — то пробел, то табуляция…

Visual Basic

'::: Загрузка данных из файла fname на лист Sho c колони colStart и строки rowStart
 
Sub import_data(Sho As Worksheet, fname As String, Optional colStart As Long = 1, Optional rowStart As Long = 1)
 
    fi% = FreeFile()
    Open fname For Input As #fi%
    
    ccc& = colStart
    rrr& = rowStart
    
    Do While Not EOF(fi%)
    
       Line Input #fi%, Stri$
       
       Stri$ = Trim$(Stri$)
       
       If Len(Stri$) > 0 Then
    
          Stri$ = Stri$ + " "
    
          Tmp$ = ""
    
          For i% = 1 To Len(Stri$)
          
              s$ = Mid$(Stri$, i%, 1)
              
              If (s$ <> " ") And (s$ <> Chr$(9)) Then
                 Tmp$ = Tmp$ + s$
              ElseIf Len(Tmp$) <> 0 Then
                 Sho.Cells(rrr&, ccc&).Value = Tmp$
                 ccc& = ccc& + 1
                 Tmp$ = ""
              End If
          
          Next i%
     
          rrr& = rrr& + 1
          ccc& = colStart
    
       End If
    
    Loop
    
    Close #fi%
 
End Sub
 
Sub Test()
 
    HomeDir$ = ThisWorkbook.Path
    import_data Лист1, HomeDir$ + "txt2.txt"
 
End Sub

Вложения

Задачи-VBA-CM.zip (10.2 Кб, 27 просмотров)

6875 / 2807 / 533

Регистрация: 19.10.2012

Сообщений: 8,562

31.08.2020, 11:14

Я думаю второй макрос из №4 пойдёт, только там где vbtab нужно прописать тот разделитель, что есть в файле.

Нет, ну ты видел?!

8 / 8 / 0

Регистрация: 21.05.2020

Сообщений: 146

31.08.2020, 11:32

[ТС]

Не могу повлиять на это, к сожалению

Получается ошибка :/
txt1.txt в папке с excel файлом есть

Миниатюры

КостяФедореев

Часто онлайн

792 / 530 / 238

Регистрация: 09.01.2017

Сообщений: 1,820

31.08.2020, 11:43

blackfisk,

Visual Basic

Sub tyyy(path)
Dim rw As Long
    Dim wb As String
    
    Workbooks.OpenText Filename:= _
        path, Origin:=866, StartRow _
        :=3, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, Comma:=False, _
        Space:=False, Other:=False, _
        DecimalSeparator:=".", TrailingMinusNumbers:=True
         
      wb = ActiveWorkbook.Name
        
        Range("A1").CurrentRegion.Copy
        ThisWorkbook.Activate
        ActiveSheet.Paste
    Application.CutCopyMode = False
    Workbooks(wb).Close
End Sub
Sub OpenDial()
 
    Dim lngCount As Long
    
    Application.ScreenUpdating = False
    Application.ShowWindowsInTaskbar = False
 
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "Текстовые файлы", "*.txt", 1
        .InitialFileName = ThisWorkbook.path
        .Show
        
        For lngCount = 1 To .SelectedItems.Count
            Call tyyy(.SelectedItems(lngCount))
        Next lngCount
 
    End With
    
    Application.ScreenUpdating = True
    Application.ShowWindowsInTaskbar = True
    
 
End Sub

С возможностью выбора файла

Narimanych

2630 / 1636 / 744

Регистрация: 23.03.2015

Сообщений: 5,142

31.08.2020, 11:43

blackfisk,

Visual Basic

Sub MMM()
Application.ScreenUpdating = False
     FL = Application.GetOpenFilename("Excel files(*.txt*),*.txt*", 1, "Выбор текстового файла", , False)
            If VarType(FL) = vbBoolean Then Exit Sub
            
            Open FL For Input As #1
                       Do Until EOF(1)
                                    Line Input #1, WD:
                                    ARR = Split(WD, Chr(9))
                                                  For i = 0 To UBound(ARR) - 1
                                                     Cells(RW, i + 1).Value = ARR(i)
                                                    Next
                                      RW = RW + 1
                            Loop
               Close #1
   Application.ScreenUpdating = True
   MsgBox "job Complete"
End Sub

blackfisk

Нет, ну ты видел?!

8 / 8 / 0

Регистрация: 21.05.2020

Сообщений: 146

31.08.2020, 11:51

[ТС]

Сообщение от КостяФедореев

blackfisk,

Visual Basic

Sub tyyy(path)
Dim rw As Long
    Dim wb As String
    
    Workbooks.OpenText Filename:= _
        path, Origin:=866, StartRow _
        :=3, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, Comma:=False, _
        Space:=False, Other:=False, _
        DecimalSeparator:=".", TrailingMinusNumbers:=True
         
      wb = ActiveWorkbook.Name
        
        Range("A1").CurrentRegion.Copy
        ThisWorkbook.Activate
        ActiveSheet.Paste
    Application.CutCopyMode = False
    Workbooks(wb).Close
End Sub
Sub OpenDial()
 
    Dim lngCount As Long
    
    Application.ScreenUpdating = False
    Application.ShowWindowsInTaskbar = False
 
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "Текстовые файлы", "*.txt", 1
        .InitialFileName = ThisWorkbook.path
        .Show
        
        For lngCount = 1 To .SelectedItems.Count
            Call tyyy(.SelectedItems(lngCount))
        Next lngCount
 
    End With
    
    Application.ScreenUpdating = True
    Application.ShowWindowsInTaskbar = True
    
 
End Sub

С возможностью выбора файла

Копирует какие то символы, и даже не всю таблицу

Добавлено через 22 секунды

Сообщение от Narimanych

blackfisk,

Visual Basic

Sub MMM()
Application.ScreenUpdating = False
     FL = Application.GetOpenFilename("Excel files(*.txt*),*.txt*", 1, "Выбор текстового файла", , False)
            If VarType(FL) = vbBoolean Then Exit Sub
            
            Open FL For Input As #1
                       Do Until EOF(1)
                                    Line Input #1, WD:
                                    ARR = Split(WD, Chr(9))
                                                  For i = 0 To UBound(ARR) - 1
                                                     Cells(RW, i + 1).Value = ARR(i)
                                                    Next
                                      RW = RW + 1
                            Loop
               Close #1
   Application.ScreenUpdating = True
   MsgBox "job Complete"
End Sub

Пишет ошибка 400 ;/

2630 / 1636 / 744

Регистрация: 23.03.2015

Сообщений: 5,142

31.08.2020, 11:54

blackfisk,
Print screen ошибки вышлите…

blackfisk

Нет, ну ты видел?!

8 / 8 / 0

Регистрация: 21.05.2020

Сообщений: 146

31.08.2020, 11:55

[ТС]

Сообщение от КостяФедореев

blackfisk,

Visual Basic

Sub tyyy(path)
Dim rw As Long
    Dim wb As String
    
    Workbooks.OpenText Filename:= _
        path, Origin:=866, StartRow _
        :=3, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, Comma:=False, _
        Space:=False, Other:=False, _
        DecimalSeparator:=".", TrailingMinusNumbers:=True
         
      wb = ActiveWorkbook.Name
        
        Range("A1").CurrentRegion.Copy
        ThisWorkbook.Activate
        ActiveSheet.Paste
    Application.CutCopyMode = False
    Workbooks(wb).Close
End Sub
Sub OpenDial()
 
    Dim lngCount As Long
    
    Application.ScreenUpdating = False
    Application.ShowWindowsInTaskbar = False
 
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "Текстовые файлы", "*.txt", 1
        .InitialFileName = ThisWorkbook.path
        .Show
        
        For lngCount = 1 To .SelectedItems.Count
            Call tyyy(.SelectedItems(lngCount))
        Next lngCount
 
    End With
    
    Application.ScreenUpdating = True
    Application.ShowWindowsInTaskbar = True
    
 
End Sub

С возможностью выбора файла

Visual Basic

Sub tyyy()
 ChDir "C:UsersadminDesktop"
    Workbooks.OpenText Filename:="C:UsersadminDesktoptxt3.txt", Origin:= _
        1251, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=False, _
        Space:=True, Other:=False, _
        TrailingMinusNumbers:=True
End Sub

Этот макрос работает, как добавить в него, чтобы он работал дальше с открывшемся окном:
Скопировал таблицу полученную — это понятно
вставил в другой excel — допустим, это понятно
Закрыл файл с таблицей без сохранения — вот это не понятно

т.к. я слабо разбираюсь в Ваших макросах, хотя б так пусть что б работало.
Приспособлю этот макрос на несколько документов, сделать бы потом, чтобы один какой то общий макрос запускал по очереди эти, вот было бы шикарно

Нет, ну ты видел?!

8 / 8 / 0

Регистрация: 21.05.2020

Сообщений: 146

31.08.2020, 11:56

[ТС]

Сообщение от Narimanych

blackfisk,
Print screen ошибки вышлите…

Указывает на строку
Cells(rw, i + 1).Value = ARR(i)

Миниатюры

Часто онлайн

792 / 530 / 238

Регистрация: 09.01.2017

Сообщений: 1,820

31.08.2020, 12:01

У меня код Narimanych, работает идеально.

Narimanych

2630 / 1636 / 744

Регистрация: 23.03.2015

Сообщений: 5,142

31.08.2020, 12:04

blackfisk,

Visual Basic

Sub MMM()
Application.ScreenUpdating = False
     FL = Application.GetOpenFilename("Excel files(*.txt*),*.txt*", 1, "Âûáîð òåêñòîâîãî ôàéëà", , False)
            If VarType(FL) = vbBoolean Then Exit Sub
       RW = 1
            Open FL For Input As #1
                       Do Until EOF(1)
                                    Line Input #1, WD:
                                    ARR = Split(WD, Chr(9))
                                                  For i = 0 To UBound(ARR) - 1
                                                     Cells(RW, i + 1).Value = ARR(i)
                                                    Next
                                      RW = RW + 1
                            Loop
               Close #1
   Application.ScreenUpdating = True
   MsgBox "job Complete"
End Sub

Добавлено через 1 минуту
blackfisk,
Можете прикрепить ваш экселевский файл( если не секретный)

blackfisk

Нет, ну ты видел?!

8 / 8 / 0

Регистрация: 21.05.2020

Сообщений: 146

31.08.2020, 12:09

[ТС]

я на чистом файле проверяю макросы,
У меня папка с пустым xlsm файлом и txt-eшниками

Добавлено через 3 минуты

Сообщение от Narimanych

blackfisk,

Visual Basic

Sub MMM()
Application.ScreenUpdating = False
     FL = Application.GetOpenFilename("Excel files(*.txt*),*.txt*", 1, "Âûáîð òåêñòîâîãî ôàéëà", , False)
            If VarType(FL) = vbBoolean Then Exit Sub
       RW = 1
            Open FL For Input As #1
                       Do Until EOF(1)
                                    Line Input #1, WD:
                                    ARR = Split(WD, Chr(9))
                                                  For i = 0 To UBound(ARR) - 1
                                                     Cells(RW, i + 1).Value = ARR(i)
                                                    Next
                                      RW = RW + 1
                            Loop
               Close #1
   Application.ScreenUpdating = True
   MsgBox "job Complete"
End Sub

Добавлено через 1 минуту
blackfisk,
Можете прикрепить ваш экселевский файл( если не секретный)

upd Скопировал, хоть и не быстро, но скопировал,
Я так понимаю вписывает он данные на активный лист, хорошо, а как ему сказать, чтобы это был не активный лист, а лист с определенным названием, к примеру page(1) ?

Источник

Мне действительно нравится Excel и, при каждом удобном случае, я стараюсь найти ему нестандартное применение. И в этот раз я задумал импортировать плей-листы радиостанций.

Вы обращали внимание, что когда вы ищете какие-то товары в интернет-магазине или когда смотрите расписание какого-либо маршрута на сайте вроде tutu.ru, в адресной строке браузера формируется url по вполне логичным правилам?

Пример
http://www.tutu.ru/rasp.php?st1=201&st2=1501&date=07.10.2015

Разбор ссылки по частям
http://www.tutu.ru/rasp.php — начальная страница сайта
Часть строки после знака вопроса — параметры, передаваемые на сервер
st1=201 — станция отправления (Беговая)
st2=1501 — станция прибытия (Трехгорка)
date=07.10.2015 — дата, за которую необходимо выгрузить расписание

Вполне понятная логика, которую также можно было бы указать и через макрос VBA. Но вернемся к плейлистам. Поисковая выдача google выдала сразу ряд сайтов, которые выгружают плейлисты. Возьмем, для примера, самую верхнюю строчку

Если в левой части сайта можно нажать на «Плейлисты радиостанций», затем выбрать интересующую нас радиостанцию и нажать в верхней части на кнопку «Плейлист радиостанции за вчера». Почему за вчера? Потому что если импортировать песни за текущий день мы получаем только часть дневного эфира и сравнение получится некорректным

Получаем ссылку вида
https://7bx.ru/radio_track/avtoradio/20151003

Здесь все просто и логично, никаких параметров
avtoradio — название радиостанции
20151003 — дата плейлиста в формате YYYYMMDD

Далее нам необходимо импортировать содержимое страницы в Excel. На помощь нам приходит макрорекордер и импорт данных. На вкладке Разработчик включаем запись макроса (или в строке состояния нажав на кружок), затем идем на вкладку «Данные» и запускаем импорт внешних данных «Из интернета»

К сожалению, как и большинство сайтов интернета, этот также не очень удобно импортировать — вместо аккуратной таблички со списком песен придется импортировать все содержимое страницы (желтая стрелочка в левом верхнем углу страницы)

Макрорекордер записал следующий код

Sub Макрос1()
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;https://7bx.ru/radio_track/avtoradio/20151005", Destination:=Range( _
        "$A$1"))
        .CommandType = 0
        .Name = "20151005"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub

Не все бактерии одинаково полезны, а макрорекордер, как всегда, записал все параметры, даже те, которые нам не нужны. Если код подсократить и объявить переменные, можно получить

Sub Macro2()
    
    Dim station As String
    Dim nDate As String
    Dim url As String: url = "https://7bx.ru/radio_track/"
    
    station = "avtoradio"
    nDate = Format(Date - 1, "YYYYMMDD") ' Смотрим плейлист за вчерашний день
    
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;" & url & station & "/" & nDate, Destination:=[A1])
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .Refresh BackgroundQuery:=False
    End With
    
End Sub

Остальное — дело техники, подчистить результат, задать массив с названиями радиостанциями и использовать цикл для загрузки плейлистов всех доступных радиостанций 🙂

Источник

Надстройки Excel
Текстовые файлы
файлы CSV
Листы Excel
Объединение файлов
Книги Excel
Массивы
Работа с файлами

Надстройка предназначена для облегчения импорта данных в Excel из текстовых файлов с разделителями (например, из CSV)

Пока во вложении — обычный файл Excel с нужными макросами, надстройку выложу позже

Использовать функции файла (надстройки) совсем не сложно.

Вот несколько примеров:

Sub ЗагрузитьТекстовыйФайлВАктивнуюЯчейку()
    CSV2Excel
End Sub
 
Sub ЗагрузитьCSVФайлВСледующуюПустуюЯчейкуПервогоСтолбца()
    CSV2Excel "a", , , , "*.csv"
End Sub
 
Sub ЗагрузитьТекстовыйФайлВНовуюКнигу()
    ' текстовый файл с разделителем "пробел"
    CSV2Excel "NewWorkbook", "Импорт данных в новую книгу", , , , " "
End Sub

60524 просмотра

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.

Источник

This is more simple than you may think, because you can invoke the Text Import Wizard (or rather, you can use its functionality) from within a macro, there’s no need to write a CSV parser or anything fancy like that.

In fact, all I’ve done with the macro below is to use the built-in record function, and then tweak it a little bit to meet you needs.

Using the Macro:

Backup your current Excel file, in case something goes wrong.
Change the definition of folder in the macro to be the path containing all of your data files — make sure you include a trailing slash.
Select the header cell of the columns, which must contain the name of a one of your files — including the file extension. You can edit this field after the data is loaded if you wish to remove the extension.
Run the macro.

Actions

It will take the file name from the current cell, look in the specified folder and open that file specified in the cell. Then it will import it as CSV, exactly one cell below the selected cell (when starting the macro).

As such, it will probably overwrite the cells below the selected cell when running the macro — caution is advised.

If the file isn’t found, or some other error occurs, this will fail with a normal VBA error box, no friendly error messages.

Macro Code

Some of this can probably be trimmed — as said I get it from a recording rather than learning how to user QueryTables myself — but it won’t hurt as it is, and seems to work reliably.

Sub LoadFromFile()
    Dim fileName As String, folder As String
    
    folder = "C:PathToYourFiles"
    fileName = ActiveCell.Value
    
    ActiveCell.Offset(1, 0).Range("A1").Select

    With ActiveSheet.QueryTables _
        .Add(Connection:="TEXT;" & folder & fileName, Destination:=ActiveCell)
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Источник

pas240886, все 3 кнопки на Ваш макрос AttachFile_test повесила. Для удобства, кнопки переименовала в имена листов. Т.е., кнопка с именем «Инвойс» копирует на лист Инвойс.
[vba]

Код

Sub AttachFile_test()    ‘ пример использования
    Application.ScreenUpdating = False
    Filename$ = GetFilePath()
    If Filename$ = «» Then Exit Sub
‘    MsgBox «Выбран файл: » & Filename$
    On Error Resume Next
        Set sh = ThisWorkbook.Sheets(Application.Caller)
        If Err <> 0 Then MsgBox «Нет такого листа»: Exit Sub
    On Error GoTo 0
    Set openWb = Workbooks.Open(Filename$)
    sh.UsedRange.Clear
    openWb.ActiveSheet.UsedRange.Copy sh.[a1]
    openWb.Close False
    Application.ScreenUpdating = True
End Sub

[/vba]

Источник

Пример импорта текстового файла при помощи макросов

Подготовим текстовый файл, который мы
будем импортировать в Excel,
например, сгенерированную некоторой
программой таблицу в текстовом виде
(рис.6):

Рисунок 6. Импортируемый текстовый файл
“result.txt”

Далее произведем импорт текстового
файла в рабочую книгу, записав при этом
процесс импорта в виде макроса, т.е.
включаем запись макроса и импортируем
файл. Для импорта файла можно либо просто
открыть файл
,
либо выбрать пункт меню “Данные Внешние
данные Импорт текстового файла …” и
далее задать нужный файл.

Выбираем параметры импорта текстового
файла (рис.7) – формат данных (с разделителями
– когда данные разделены каким-то
символом-разделителем, например
вертикальной чертой |, или фиксированной
ширины – когда данные имеют строго
определенную ширину, например, данные
из первого столбца должны занимать
строго 6 символов), начальную строку
импорта, кодировку тестового файла.
Нажимаем кнопку “Далее” для перехода
к следующему шагу импорта файла.

На втором шаге следует выбрать
символ-разделитель данных (рис.8), в
приведенном примере – это символ
вертикальной черты |. И переходим к
третьему шагу.

На третьем шаге (рис.9) выбираем для наших
столбцов формат данных (тип данных).
Данный пункт можно пропустить, а формат
данных указать уже после в самой книге.
Нажимаем кнопку “Готово” – для
завершения импорта и перехода к рабочей
книге. При этом появляется запрос на
выбор места размещения импортируемых
данных (рис.10).

Останавливаем процесс записи макроса.
Результат импорта представлен на рисунке
11.

Рисунок 7. Выбор формата данных
Рисунок 8. Выбор символа-разделителя

Рисунок 9. Выбор типа столбцов
Рисунок 10. Выбор место размещения

Рисунок 11. Результат импорта файла

Перейдем в редактор VisualBasicдля работы с кодом макроса. Код записанного
макроса представлен ниже:

Sub
Макрос2()

‘

‘
Макрос2 Макрос

‘
Макрос записан 13.10.2004 (nkonchits)

‘

ActiveWorkbook.Worksheets.Add

With
ActiveSheet.QueryTables.Add(Connection:= _

«TEXT;C:Documents
and SettingsnkonchitsМои
документыresult.txt»,
_

Destination:=Range(«A1»))

.Name
= «result»

.FieldNames
= True

.RowNumbers
= False

.FillAdjacentFormulas
= False

.PreserveFormatting
= True

.RefreshOnFileOpen
= False

.RefreshStyle
= xlInsertDeleteCells

.SavePassword
= False

.SaveData
= True

.AdjustColumnWidth
= True

.RefreshPeriod
= 0

.TextFilePromptOnRefresh
= False

.TextFilePlatform
= xlWindows

.TextFileStartRow
= 1

.TextFileParseType
= xlDelimited

.TextFileTextQualifier
= xlTextQualifierDoubleQuote

.TextFileConsecutiveDelimiter
= False

.TextFileTabDelimiter
= False

.TextFileSemicolonDelimiter
= False

.TextFileCommaDelimiter
= False

.TextFileSpaceDelimiter
= False

.TextFileOtherDelimiter
= «|»

.TextFileColumnDataTypes
= Array(1, 2, 1, 1, 1, 1)

.Refresh
BackgroundQuery:=False

End
With

End
Sub

Однако данный макрос обладает недостатком,
т.к. он не является универсальным для
импорта большого количества однотипных
файлов с разными именами. Для этого
следует внести некоторые изменения в
макрос: добавить выбор (задание) имени
файла. За выбор имени файла в макросе
отвечает фрагмент кода:

With
ActiveSheet.QueryTables.Add(Connection:= _

«TEXT;C:Documents
and SettingsnkonchitsМои документыresult.txt», _

а для
задания ввода имени файла можно
воспользоваться методом

InputBox(prompt[,
title] [, default] [, xpos] [, ypos] [, helpfile, context])

и
заменить прописанное имя файла
“C:DocumentsandSettingsnkonchitsМои
документыresult.txt”
на данный метод. В итоге получиться
следующий фрагмент кода:

With
ActiveSheet.QueryTables.Add(Connection:= _

«TEXT;»
+ InputBox(«Введите имя файла для импорта
в Excel: «), _

Далее в момент запуска макроса происходит
запрос имени файла (рис.12).

Рисунок 12. Запрос ввода имени файла для
импорта

Соседние файлы в предмете [НЕСОРТИРОВАННОЕ]

Источник

It’s time to learn how to use VBA and Macros to import data from a web page into Excel!

This is the advanced way to get almost any piece of data from a web page and to bring it into Excel and I take the tutorial step-by-step to explain everything that you need to do.

As well, the macro that we use is a very simple yet powerful and robust piece of code that will work in a wide variety of situations and that does not require the browser to open or be used at all.

This tutorial walks you through each line of the macro required to perform the import so that you will understand it and be able to change it for your specific purposes. As well, this covers different elements of a web page that you need to understand in order to make better web imports of data using VBA.

I hope you enjoy the tutorial!

Excel VBA Course — From Beginner to Expert

200+ Video Lessons
50+ Hours of Instruction
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

Subscribe for Weekly Tutorials

BONUS: subscribe now to download our Top Tutorials Ebook!

Excel VBA Course — From Beginner to Expert

200+ Video Lessons

50+ Hours of Video

200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

Источник