Текстовых файлов excel макрос

  • Обработка таблиц
  • Текстовые файлы
  • Книги Excel
  • Перевод и кодировка
  • текстовые строки
  • Работа с файлами
  • Разное

Макрос предназначен для создания текстовых файлов в кодировке UTF-8.

Исходными данными является таблица Excel из 12 столбцов.

Сначала, макрос создаёт папку для будущих текстовых файлов.
Папка создаётся в том же каталоге, где расположена книга Excel.

Далее, для каждой строки таблицы, макрос формирует подпапку,
используя в качестве её названия текст из 7-го столбца таблицы.

И потом, когда папка для файла создана, макрос создаёт текстовый файл с содержимым из 10 столбца таблицы,
и сохраняет его под именем, взятым из второго столбца той же таблицы Excel.
После создания файла, у него меняется кодировка на UTF-8 (изначально, при создании, файлы имеют кодировку Unicode)

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

Пример макроса смотрите в прикреплённом файле.


Код макроса, создающего папки, подпапки, и текстовые файлы по данным из таблицы Excel:

Sub СозданиеТекстовыхФайлов()
    On Error Resume Next
    Dim cell As Range, ra As Range
    Set ra = Range([A2], Range("A" & Rows.Count).End(xlUp)).Resize(, 11)
    arr = ra.Value    ' считываем данные в массив

    Set FSO = CreateObject("scripting.filesystemobject")
    ' создаём главную папку
    BaseFolder$ = ThisWorkbook.Path & "Товар по группам": MkDir BaseFolder$
 
    ' перебираем все строки
    For i = LBound(arr) To UBound(arr)
        ' создаём папку для очередной строки (если папки ещё нет)
        Folder$ = BaseFolder$ & arr(i, 7) & ""    ' имя папки - в столбце G
        MkDir Folder$
 
        ' формируем имя создаваемого текстового файла
        Filename$ = Folder$ & Trim(arr(i, 2)) & ".txt"
 
        ' создаём файл в кодировке Unicode
        Set ts = FSO.CreateTextFile(Filename$, True, True)
        ts.Write Trim(arr(i, 10))    ' данные в файл - из ячейки 10-го столбца
        ts.Close
 
        ' если текстовый файл нужен в другой кодировке
        ChangeFileCharset Filename$, "utf-8"
    Next i
 
    Set ts = Nothing: Set FSO = Nothing
    MsgBox "Файлы созданы, и помещены в папку" & vbNewLine & BaseFolder$, vbInformation, "Готово"
 
    ' открываем папку с файлами
    CreateObject("wscript.shell").Run "explorer.exe /e, """ & BaseFolder$ & """"
End Sub
  • 66692 просмотра

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

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

VBA Program to read a Text file line by line (Sales Data) and places on a worksheet. 

Sales Data in Text File: 5 Fields [ Product, Qtr 1, Qtr 2, Qtr 3 and Qtr 4 ] and 25 Records (Incl. header)

Sales data

VBA code will read a text file and places on worksheet cells as below

VBA Code:

  • Declaring variables:
Variables Data Type Comments
line String Read text file line by line
Filename String Input file name (Full path)
i Integer Iterator
valueArr() String split the sentence by comma and store it in an array variable of type String
    'Variable declarations
    Dim line As String, Filename As String, i As Integer, valuesArr() As String
  • Initialize “Filename” variable with full path and filename
    'Text file fullPath
    Filename = "D:ExcelReadTextFilesales.txt" 'update your full file path
    i = 1
  • Open input file to read text 
    'Open file
    Open Filename For Input As #2
  • Read input file line by line
    'Read line by line - text file
    While Not EOF(2)
        Line Input #2, line
  • Split by comma and store it in valueArr().  In our example, each line has 5 values concatenated with comma.
        'split the line by comma separated, assigned in an array
        valuesArr() = Split(line, ",")
  • Add text to respective cells from valuesArr().  Read each item in an array by it’s index value
        Cells(i, "A").Value = valuesArr(0)
        Cells(i, "B").Value = valuesArr(1)
        Cells(i, "C").Value = valuesArr(2)
        Cells(i, "D").Value = valuesArr(3)
        Cells(i, "E").Value = valuesArr(4)
  • Increment counter i, to move next line.
        i = i + 1
  • Close while loop
    Wend
  • Close file
'Close file
Close #2

Approach:

Step 1: Open Excel.

Step 2: Add a shape (Read Text File) to your worksheet  .

Step 3: Right-click on “Read Text file” and “Assign Macro..”

Step 4: Select ReadTextFileLineByLine Macro

Step 5: Save your excel file as “Excel Macro-Enabled Workbook”  *.xlsm

Step 6: Click “Read Text file” 

Step 7: Adjust column width in your excel file.

Создание файлов Excel методами Workbooks.Add, Worksheet.Copy и текстовых файлов с помощью оператора Open и метода CreateTextFile из кода VBA Excel. Создание документов Word рассмотрено в отдельной статье.

Метод Workbooks.Add

Описание

Файлы Excel можно создавать из кода VBA с помощью метода Add объекта Workbooks.

Workbooks.Add – это метод, который создает и возвращает новую книгу Excel. Новая книга после создания становится активной.

Ссылку на новую книгу Excel, созданную методом Workbooks.Add, можно присвоить объектной переменной с помощью оператора Set или обращаться к ней, как к активной книге: ActiveWorkbook.

Синтаксис

Workbooks.Add (Template)

Template – параметр, который определяет, как создается новая книга.

Значение Template Параметры новой книги
Отсутствует Новая книга с количеством листов по умолчанию.
Полное имя существующего файла Excel Новая книга с указанным файлом в качестве шаблона.
xlWBATChart Новый файл с одним листом диаграммы.
xlWBATWorksheet Новый файл с одним рабочим листом.

Примеры

Пример 1
Создание новой книги Excel с количеством листов по умолчанию и сохранение ее в папку, где расположен файл с кодом VBA:

Sub Primer1()

‘Создаем новую книгу

Workbooks.Add

‘Сохраняем книгу в папку, где расположен файл с кодом

ActiveWorkbook.SaveAs (ThisWorkbook.Path & «Моя новая книга.xlsx»)

‘Закрываем файл

ActiveWorkbook.Close

End Sub

Файл «Моя новая книга.xlsx» понадобится для следующего примера.

Пример 2
Создание новой книги по файлу «Моя новая книга.xlsx» в качестве шаблона с присвоением ссылки на нее объектной переменной, сохранение нового файла с новым именем и добавление в него нового рабочего листа:

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

Sub Primer2()

‘Объявляем объектную переменную с ранней привязкой

Dim MyWorkbook As Workbook

‘Создаем новую книгу по шаблону файла «Моя новая книга.xlsx»

Set MyWorkbook = Workbooks.Add(ThisWorkbook.Path & «Моя новая книга.xlsx»)

    With MyWorkbook

        ‘Смотрим какое имя присвоено новому файлу по умолчанию

        MsgBox .Name ‘»Моя новая книга1″

        ‘Сохраняем книгу с новым именем

        .SaveAs (ThisWorkbook.Path & «Моя самая новая книга.xlsx»)

        ‘Смотрим новое имя файла

        MsgBox .Name ‘»Моя самая новая книга»

        ‘Добавляем в книгу новый лист с именем «Мой новый лист»

        .Sheets.Add.Name = «Мой новый лист»

        ‘Сохраняем файл

        .Save

    End With

End Sub

Метод Worksheet.Copy

Описание

Если в коде VBA Excel применить метод Worksheet.Copy без указания параметра Before или After, будет создана новая книга с копируемым листом (листами). Новая книга станет активной.

Примеры

Пример 3
Создание новой книги с помощью копирования одного листа (в этом примере используется книга, созданная в первом примере):

Sub Primer3()

‘Если книга источник не открыта, ее нужно открыть

Workbooks.Open (ThisWorkbook.Path & «Моя новая книга.xlsx»)

‘Создаем новую книгу копированием одного листа

Workbooks(«Моя новая книга.xlsx»).Worksheets(«Лист1»).Copy

‘Сохраняем новую книгу с именем «Еще одна книжица.xlsx» в папку,

‘где расположен файл с кодом

ActiveWorkbook.SaveAs (ThisWorkbook.Path & «Еще одна книжица.xlsx»)

End Sub

Также, как и при создании нового файла Excel методом Workbooks.Add, при создании новой книги методом Worksheet.Copy, можно ссылку на нее присвоить объектной переменной.

Пример 4
Создание новой книги, в которую включены копии всех рабочих листов из файла с кодом VBA:

Sub Primer4()

ThisWorkbook.Worksheets.Copy

End Sub

Пример 5
Создание новой книги, в которую включены копии выбранных рабочих листов из файла с кодом VBA:

Sub Primer5()

ThisWorkbook.Sheets(Array(«Лист1», «Лист3», «Лист7»)).Copy

End Sub

Создание текстовых файлов

Оператор Open

При попытке открыть несуществующий текстовый файл с помощью оператора Open, такой файл будет создан. Новый файл будет создан при открытии его в любом режиме последовательного доступа, кроме Input (только для чтения).

Пример

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

Sub Primer6()

Dim ff As Integer, ws As Object

‘Получаем свободный номер для открываемого файла

ff = FreeFile

‘Создаем новый текстовый файл путем открытия

‘несуществующего в режиме чтения и записи

Open ThisWorkbook.Path & «Мой-новый-файл.txt» For Output As ff

‘Записываем в файл текст

Write #ff, «Этот файл создан при его открытии оператором « & _

«Open по несуществующему адресу (полному имени).»

‘Закрываем файл

Close ff

‘Открываем файл для просмотра

Set ws = CreateObject(«WScript.Shell»)

ws.Run ThisWorkbook.Path & «Мой-новый-файл.txt»

Set ws = Nothing

End Sub

В имени текстового файла пробелы заменены дефисами (знаками минус), так как метод Run объекта Wscript.Shell не способен открывать файлы с именами, содержащими пробелы.

Рекомендую открывать файлы для просмотра методом ThisWorkbook.FollowHyperlink. Пример и преимущества этого метода в статье VBA Excel. Открыть файл другой программы.

Метод FileSystemObject.CreateTextFile

Для создания нового текстового файла из кода VBA Excel по указанному имени, можно использовать метод CreateTextFile объекта FileSystemObject.

Пример

Sub Primer7()

Dim fso, fl, ws

‘Создаем новый экземпляр объекта FileSystemObject

Set fso = CreateObject(«Scripting.FileSystemObject»)

‘Присваиваем переменной fl новый объект TextStream,

‘связанный с созданным и открытым для записи файлом

Set fl = fso.CreateTextFile(ThisWorkbook.Path & «Еще-один-текстовый-файл.txt»)

‘Записываем в файл текст

fl.Write («Этот текстовый файл создан методом CreateTextFile объекта FileSystemObject.»)

‘Закрываем файл

fl.Close

‘Открываем файл для просмотра

Set ws = CreateObject(«WScript.Shell»)

ws.Run ThisWorkbook.Path & «Еще-один-текстовый-файл.txt»

End Sub

Стоит отметить, что новый текстовый файл может быть создан и с помощью метода OpenTextFile объекта FileSystemObject при условии присвоения параметру create значения True.

Макрос создания текстовых файлов по таблице Excel

  • Макросы VBA Excel
  • Работа с диапазонами ячеек и листами
  • Текстовые строки
  • Текстовые файлы
  • Обработка таблиц
  • Текстовые файлы
  • Книги Excel
  • Перевод и кодировка
  • текстовые строки
  • Работа с файлами
  • Разное

Макрос предназначен для создания текстовых файлов в кодировке UTF-8.

Исходными данными является таблица Excel из 12 столбцов.

Сначала, макрос создаёт папку для будущих текстовых файлов.
Папка создаётся в том же каталоге, где расположена книга Excel.

Далее, для каждой строки таблицы, макрос формирует подпапку,
используя в качестве её названия текст из 7-го столбца таблицы.

И потом, когда папка для файла создана, макрос создаёт текстовый файл с содержимым из 10 столбца таблицы,
и сохраняет его под именем, взятым из второго столбца той же таблицы Excel.
После создания файла, у него меняется кодировка на UTF-8 (изначально, при создании, файлы имеют кодировку Unicode)

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

Пример макроса смотрите в прикреплённом файле.


Код макроса, создающего папки, подпапки, и текстовые файлы по данным из таблицы Excel:

Sub СозданиеТекстовыхФайлов()
    On Error Resume Next
    Dim cell As Range, ra As Range
    Set ra = Range([A2], Range("A" & Rows.Count).End(xlUp)).Resize(, 11)
    arr = ra.Value    ' считываем данные в массив

    Set FSO = CreateObject("scripting.filesystemobject")
    ' создаём главную папку
    BaseFolder$ = ThisWorkbook.Path & "Товар по группам": MkDir BaseFolder$
 
    ' перебираем все строки
    For i = LBound(arr) To UBound(arr)
        ' создаём папку для очередной строки (если папки ещё нет)
        Folder$ = BaseFolder$ & arr(i, 7) & ""    ' имя папки - в столбце G
        MkDir Folder$
 
        ' формируем имя создаваемого текстового файла
        Filename$ = Folder$ & Trim(arr(i, 2)) & ".txt"
 
        ' создаём файл в кодировке Unicode
        Set ts = FSO.CreateTextFile(Filename$, True, True)
        ts.Write Trim(arr(i, 10))    ' данные в файл - из ячейки 10-го столбца
        ts.Close
 
        ' если текстовый файл нужен в другой кодировке
        ChangeFileCharset Filename$, "utf-8"
    Next i
 
    Set ts = Nothing: Set FSO = Nothing
    MsgBox "Файлы созданы, и помещены в папку" & vbNewLine & BaseFolder$, vbInformation, "Готово"
 
    ' открываем папку с файлами
    CreateObject("wscript.shell").Run "explorer.exe /e, """ & BaseFolder$ & """"
End Sub

Вложение

Размер

Загрузки

Последняя загрузка

prays.xls

38.5 КБ

170

8 часов 11 минут назад

  • 35605 просмотров
 

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

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

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

Chelovek, потестируйте файл

 

Chelovek

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

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

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

 

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

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

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

#5

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

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

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

#7

01.02.2022 00:00:16

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

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

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

Изменено: New01.02.2022 00:02:35

 

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

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

 

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

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

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

#9

01.02.2022 09:45:40

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

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

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

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

 

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

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

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

 

New

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

Сообщений: 4582
Регистрация: 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

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

Сообщений: 10852
Регистрация: 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

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

Сообщений: 4582
Регистрация: 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

Изменено: New20.12.2022 20:11:14

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

8 / 8 / 0

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

Сообщений: 146

1

31.08.2020, 08:17. Показов 10692. Ответов 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 файла недостаточно, помогите :/
Спасибо



0



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 в БД Лотус
Вроде тема поднимлась так или иначе, но то что нужно не нашла.
Пожалуйста, поделитесь скриптом,…

74

Часто онлайн

792 / 530 / 238

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

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

31.08.2020, 09:51

2

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



0



Narimanych

2632 / 1637 / 745

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

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

31.08.2020, 09:52

3

blackfisk,

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
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



0



blackfisk

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

8 / 8 / 0

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

Сообщений: 146

31.08.2020, 10:05

 [ТС]

4

Цитата
Сообщение от Narimanych
Посмотреть сообщение

blackfisk,

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
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
1
2
3
4
5
6
7
8
9
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

Миниатюры

Импорт текста из txt в excel
 



0



2632 / 1637 / 745

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

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

31.08.2020, 10:15

5

blackfisk,

Цитата
Сообщение от blackfisk
Посмотреть сообщение

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

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



0



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

8 / 8 / 0

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

Сообщений: 146

31.08.2020, 10:44

 [ТС]

6

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



0



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

Часто онлайн

792 / 530 / 238

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

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

31.08.2020, 11:01

7

blackfisk,

Visual Basic
1
2
3
4
5
6
7
8
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



0



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

8 / 8 / 0

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

Сообщений: 146

31.08.2020, 11:08

 [ТС]

8

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

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



0



Catstail

Модератор

Эксперт функциональных языков программированияЭксперт Python

34709 / 19230 / 4040

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

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

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

31.08.2020, 11:14

9

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

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
'::: Загрузка данных из файла 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

Вложения

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



0



6875 / 2807 / 533

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

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

31.08.2020, 11:14

10

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



0



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

8 / 8 / 0

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

Сообщений: 146

31.08.2020, 11:32

 [ТС]

11

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

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

Миниатюры

Импорт текста из txt в excel
 



0



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

Часто онлайн

792 / 530 / 238

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

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

31.08.2020, 11:43

12

blackfisk,

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
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

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



0



Narimanych

2632 / 1637 / 745

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

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

31.08.2020, 11:43

13

blackfisk,

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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



0



blackfisk

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

8 / 8 / 0

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

Сообщений: 146

31.08.2020, 11:51

 [ТС]

14

Цитата
Сообщение от КостяФедореев
Посмотреть сообщение

blackfisk,

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
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
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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 ;/



0



2632 / 1637 / 745

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

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

31.08.2020, 11:54

15

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



0



blackfisk

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

8 / 8 / 0

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

Сообщений: 146

31.08.2020, 11:55

 [ТС]

16

Цитата
Сообщение от КостяФедореев
Посмотреть сообщение

blackfisk,

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
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
1
2
3
4
5
6
7
8
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 — допустим, это понятно
Закрыл файл с таблицей без сохранения — вот это не понятно

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



0



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

8 / 8 / 0

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

Сообщений: 146

31.08.2020, 11:56

 [ТС]

17

Цитата
Сообщение от Narimanych
Посмотреть сообщение

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

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

Миниатюры

Импорт текста из txt в excel
 



0



Часто онлайн

792 / 530 / 238

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

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

31.08.2020, 12:01

18

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



0



Narimanych

2632 / 1637 / 745

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

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

31.08.2020, 12:04

19

blackfisk,

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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,
Можете прикрепить ваш экселевский файл( если не секретный)



0



blackfisk

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

8 / 8 / 0

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

Сообщений: 146

31.08.2020, 12:09

 [ТС]

20

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

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

Цитата
Сообщение от Narimanych
Посмотреть сообщение

blackfisk,

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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) ?



0



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

Подготовим текстовый файл, который мы
будем импортировать в 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. Запрос ввода имени файла для
импорта

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

  • #
  • #
  • #
  • #
  • #
  • #
  • #
  • #
  • #
  • #
  • #

Excel VBA Запись текстового файла

В VBA мы можем открыть, прочитать или записать текстовый файл. Запись текстового файла означает, что данные у нас есть на листе Excel, и мы хотим, чтобы это был текстовый файл или файл блокнота. Поэтому есть два метода: свойство FileSystemObject VBA и метод Open and Write в VBA.

В большинстве корпоративных компаний после завершения отчета они стараются загрузить отчет в базу данных. Они используют формат «текстовые файлы» для обновления базы данных для загрузки в базу данных. Обычно мы копируем данные из Excel и вставляем их в текстовый файл. Мы полагаемся на текстовые файлы, потому что с ними очень легко работать из-за их легкости и простоты. Используя кодирование VBAИспользование кодирования VBAКод VBA представляет собой набор инструкций, написанных пользователем на языке программирования приложений Visual Basic в редакторе Visual Basic (VBE) для выполнения определенной задачи. Подробнее, мы можем автоматизировать задачу копирования данных из файл Excel в текстовый файл. В этой статье показано, как копировать или записывать данные из файла Excel в текстовый файл с помощью кода VBA.

Оглавление

  • Excel VBA Запись текстового файла
    • Как записать данные в текстовые файлы с помощью VBA?
      • Синтаксис открытого текстового файла
      • Пример №1
        • Шаг 1: Объявить переменную
        • Шаг 2: Определите номер файла
        • Шаг 3: Назначьте путь к файлу
        • Шаг 4: Назначьте бесплатную функцию файла
        • Шаг 5: Откройте текстовый файл
        • Шаг 6: Используйте метод печати/записи
        • Шаг 7: Сохраните и закройте текстовый файл
      • Пример #2
    • Рекомендуемые статьи

Текстовый файл записи VBA

Как записать данные в текстовые файлы с помощью VBA?

Запись данных из Excel в текст сложна и требует очень хороших знаний кодирования VBA. Выполните следующие шаги, чтобы написать код VBA для копирования dataWrite Код VBA для копирования DataFile Copy — это встроенная функция VBA, которая используется для копирования файла из одного места в другое. Чтобы использовать эту функцию, мы должны указать текущий путь к файлу, а также путь к файлу назначения. читать больше из Excel в текстовый файл.

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

Синтаксис открытого текстового файла

Открыть [File Path]Для [Mode]Как [File Number]

Путь к файлу: Путь к файлу, который мы пытаемся открыть на компьютере.

Режим: Режим — это контроль, который мы можем иметь при открытии текстовых файлов. У нас может быть три типа контроля над текстовым файлом.

  • Режим ввода: Это предполагает управление открывающимся текстовым файлом только для чтения. Если мы используем «Режим ввода», мы ничего не можем сделать с файлом. Вместо этого мы можем просто прочитать содержимое текстового файла.
  • Режим вывода: Мы можем написать содержание на этой опции. Мы должны помнить, что он перезапишет все существующие данные. Итак, мы должны опасаться возможной потери старых данных.
  • Режим добавления: Этот режим полностью противоположен Выходной режим. Используя этот метод, мы можем записать новые данные в конец существующих данных в файле.

Номер дела: Это подсчитает количество текстовых файлов всех открытых текстовых файлов. Он распознает открытые номера файлов в виде целых чисел от 1 до 511. Однако присвоение номера файла сложно и приводит к путанице. Для этого мы можем использовать бесплатную функцию File.

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

.free_excel_div{фон:#d9d9d9;размер шрифта:16px;радиус границы:7px;позиция:относительная;margin:30px;padding:25px 25px 25px 45px}.free_excel_div:before{content:»»;фон:url(центр центр без повтора #207245;ширина:70px;высота:70px;позиция:абсолютная;верх:50%;margin-top:-35px;слева:-35px;граница:5px сплошная #fff;граница-радиус:50%} Вы можете скачать этот шаблон текстового файла записи VBA здесь — Шаблон текстового файла записи VBA

Пример №1

Выполните следующие шаги, чтобы написать код для создания нового текстового файла.

Предположим, у вас уже есть текстовый файл с именем «Hello.txt» в памяти вашего компьютера, и мы покажем вам, как записать в него данные.

Шаг 1: Объявить переменную

Объявите переменную для хранения пути к файлу как строку.

Код:

Sub TextFile_Example1 () Dim Path As String End Sub

Пример записи текста VBA 1-1Шаг 2: Определите номер файла

Чтобы определить, на какой номер файла мы ссылаемся, объявите еще одну переменную как IntegerVariable. Поскольку IntegerIn VBA целое число — это тип данных, который может быть присвоен любой переменной и использоваться для хранения целочисленных значений. В VBA скобка для максимального числа целочисленных переменных, которые можно сохранить, аналогична скобке в других языках. Используя оператор DIM, любую переменную можно определить как целочисленную переменную.Подробнее.

Код:

Sub TextFile_Example1() Dim Path As String Dim FileNumber As Integer End Sub

Пример записи текста VBA 1-2Шаг 3: Назначьте путь к файлу

Теперь назначьте путь к файлу с именем для переменной Path.

Код:

Sub TextFile_Example1() Dim Path As String Dim FileNumber As Integer Path = «D:Excel FilesVBA FileHello.txt» ‘Измените путь в соответствии с вашими требованиями End Sub

Пример записи текста VBA 1-3Шаг 4: Назначьте бесплатную функцию файла

Теперь назначьте функцию «Свободный файл» для хранения уникальных номеров файлов для переменной «Номер файла».

Код:

Sub TextFile_Example1() Dim Path As String Dim FileNumber As Integer Path = «D:Excel FilesVBA FileHello.txt» ‘Измените путь в соответствии с вашими требованиями FileNumber = FreeFile End Sub

Пример записи текста VBA 1-4Шаг 5: Откройте текстовый файл

Теперь нам нужно открыть текстовый файл, чтобы работать с ним. Как мы объяснили, нам нужно использовать оператор OPEN, чтобы открыть текстовый файл.

Пример 1-5
Шаг 6: Используйте метод печати/записи

Как только файл откроется, нам нужно что-то в нем написать. Нам нужен метод «Запись» или «Печать» для записи в текстовый файл.

Код:

Sub TextFile_Example1() Dim Path As String Dim FileNumber As Integer Path = «D:Excel FilesVBA FileHello.txt» ‘Измените путь в соответствии с вашими требованиями FileNumber = FreeFile Open Path For Output As FileNumber Print #FileNumber, «Welcome» Print #FileNumber , «to» Print #FileNumber, «VBA» End Sub

Пример 1-6

Во-первых, нам нужно указать номер файла (здесь мы присвоили файлу переменную «FileNumber»), затем нам нужно добавить содержимое, которое мы хотим добавить в текстовый файл.

Шаг 7: Сохраните и закройте текстовый файл

Как только мы запишем содержимое в текстовый файл, нам нужно сохранить и закрыть текстовый файл.

Код:

Sub TextFile_Example1() Dim Path As String Dim FileNumber As Integer Path = «D:Excel FilesVBA FileHello.txt» ‘Измените путь в соответствии с вашими требованиями FileNumber = FreeFile Open Path For Output As FileNumber Print #FileNumber, «Welcome» Print #FileNumber , «to» Print #FileNumber, «VBA» Close FileNumber End Sub

Пример 1-7

Теперь запустите код вручную или с помощью сочетания клавиш Excel. Ярлык Excel. Ярлык Excel — это метод выполнения ручного задания более быстрым способом. Подробнее F5. Он запишет указанный контент в указанный текстовый файл.

Пример записи текста VBA 1-8Пример #2

Теперь мы увидим, как записать данные листа Excel в текстовый файл.

Для этого примера мы создали простые данные в Excel, как показано ниже.

Пример записи текста VBA 1

Шаг 1: Продолжая старый пример, определите еще две переменные как Integer, чтобы найти последнюю строку и последний столбец.

Код:

Sub TextFile_Example2() Dim Path As String Dim FileNumber As Integer Dim LR As Integer Dim LC As Integer End Sub

Пример записи текста VBA 2

Шаг 2: Найдите последнюю использованную строку и столбец на листе.

Пример записи текста VBA 2-1

Шаг 3: Теперь назначьте путь к файлу и номер файла.

Пример записи текста VBA 2-2

Шаг 4: Используйте оператор OPEN, чтобы открыть текстовый файл.

Пример записи текста VBA 2-3

Шаг 5: Нам нужно перебирать строки и столбцы, поэтому объявите еще две переменные как Integer.

Пример записи текста VBA 2-4

Шаг 6: Теперь откройте цикл, чтобы перебрать строку (для следующего цикла в VBAFor Next Loop В VBAВсе языки программирования используют цикл For Next в VBA. После оператора FOR в этом цикле есть критерий, и код повторяется до тех пор, пока не критерии достигнуты. читать дальше)

Пример записи текста VBA 2-5

Шаг 7: Чтобы выполнить цикл по столбцам, откройте еще один цикл внутри существующего цикла.

Пример записи текста VBA 2-6

Шаг 8: Нам нужно писать одну и ту же строку данных, пока она не достигнет последнего столбца. Поэтому для этого примените оператор IF в VBA.

Пример 2-7

Шаг 9: Теперь сохраните и закройте текстовый файл.

Пример 2-8

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

Пример 2-9

Код:

Sub TextFile_Example2() Dim Path As String Dim FileNumber As Integer Dim LR As Integer Dim LC As Integer Dim k As Integer Dim i As Integer LR = Worksheets(«Text»).Cells(Rows.Count, 1).End(xlUp) .Row LC = Рабочие листы («Текст»). Ячейки (1, Столбцы. Количество). Конец (xlToLeft). Путь к столбцу = «D: Excel FilesVBA FileHello.txt» FileNumber = FreeFile Открытый путь для вывода в виде FileNumber For k = 1 В LR Для i = 1 В LC Если i <> LC Затем напечатать #FileNumber, Cells(i, k), иначе Напечатать #FileNumber, Cells(i, k) End If Next i Next k Закрыть FileNumber Shell «notepad.exe » & Путь, vbNormalFocus End Sub

Итак, запускаем код с помощью клавиши F5 или вручную. Затем он скопирует данные ниже.

Пример записи текста VBA 2-10

Рекомендуемые статьи

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

  • VBA Подождите
  • Диалоговое окно файла VBA
  • Функция InStr VBA
Sub LoadTXT()
    Dim sFiles As String, s As String, r As Double
    Cells.Clear
    sFiles = "Z:Filename.txt"
    Open sFiles For Input As #1
    Do While Not EOF(1)
        Line Input #1, s
        If InStr(1, s, ";") > 0 Then
        
        '        если ключ раздела по столбцам считались как одну. Но это не правильно!!.
                Do While InStr(1, s, ";;") > 0 '
                    s = Replace(s, ";;", ";") '
                Loop
                
                t = Split(s, ";")
                r = r + 1
                For i = 0 To UBound(t)
                        Cells(r, i + 1) = t(i)
                 Next i
         
        End If
    Loop
    Close #1
End Sub

Like this post? Please share to your friends:
  • Текстовыми редакторами являются opera ms excel
  • Текстовыми редакторами являются notepad ms excel
  • Текстовыми редакторами являются ms excel kompozer winrar
  • Текстовыми редакторами являются microsoft word
  • Текстовым файлом в word является