Добрый день! Опишу вопрос подробно: Есть текстовый файл(во вложении), нужно из этого файла скопировать данные от слов "конец" до "конец" в одну ячейку(Слово "конец" можно заменить на любое другое). Я заранее извиняюсь если не понятно выразил вопрос! Напишите, я уточню. Данные надо скопировать в прайс в третий столбец(во вложении). Возможно вместо слов "конец" нужно вставить какой то тег?!
Добрый день! Опишу вопрос подробно: Есть текстовый файл(во вложении), нужно из этого файла скопировать данные от слов "конец" до "конец" в одну ячейку(Слово "конец" можно заменить на любое другое). Я заранее извиняюсь если не понятно выразил вопрос! Напишите, я уточню. Данные надо скопировать в прайс в третий столбец(во вложении). Возможно вместо слов "конец" нужно вставить какой то тег?!MicExcel
MicExcel, здравствуйте. Если просто скопировать все части от "конец" до "конец", то можно так: [vba]
Код
Sub readFile() Dim fso Set fso = CreateObject("Scripting.FileSystemObject") Dim MyFile, myStr As String Set MyFile = fso.OpenTextFile("C:\111.txt") Dim i&: i = 1 Do While MyFile.AtEndOfStream <> True myStr = "" Do While MyFile.ReadLine <> "конец" myStr = myStr + MyFile.ReadLine Loop Cells(i, 3) = WorksheetFunction.Trim( _ WorksheetFunction.Clean( _ Replace( _ Replace( _ Replace( _ myStr _ , vbLf, " ") _ , vbCr, " ") _ , vbTab, " ") _ )) Cells(i, 4) = i i = i + 1 Loop End Sub
[/vba] Замену непечатных символов взяла у Gustavа Макрос работает не корректно, но мне сейчас некогда его доделывать, а такой вариант может помочь Вам оттолкнуться.
MicExcel, здравствуйте. Если просто скопировать все части от "конец" до "конец", то можно так: [vba]
Код
Sub readFile() Dim fso Set fso = CreateObject("Scripting.FileSystemObject") Dim MyFile, myStr As String Set MyFile = fso.OpenTextFile("C:\111.txt") Dim i&: i = 1 Do While MyFile.AtEndOfStream <> True myStr = "" Do While MyFile.ReadLine <> "конец" myStr = myStr + MyFile.ReadLine Loop Cells(i, 3) = WorksheetFunction.Trim( _ WorksheetFunction.Clean( _ Replace( _ Replace( _ Replace( _ myStr _ , vbLf, " ") _ , vbCr, " ") _ , vbTab, " ") _ )) Cells(i, 4) = i i = i + 1 Loop End Sub
[/vba] Замену непечатных символов взяла у Gustavа Макрос работает не корректно, но мне сейчас некогда его доделывать, а такой вариант может помочь Вам оттолкнуться.Manyasha
ЯД: 410013299366744 WM: R193491431804
Сообщение отредактировал Manyasha - Вторник, 17.03.2015, 18:57
Sub readFile() Dim MyFile, i& MyFile = Split(CreateObject("Scripting.FileSystemObject").Getfile("C:\Downloads\MicExcel\7348509.txt").OpenasTextStream(1).ReadAll, "РєРѕРЅРµС")
For i = 1 To UBound(MyFile) - 1 Cells(i, 3) = WorksheetFunction.Trim( _ WorksheetFunction.Clean( _ Replace( _ Replace( _ Replace( _ MyFile(i) _ , vbLf, " ") _ , vbCr, " ") _ , vbTab, " ") _ )) Next End Sub
[/vba] Про кодировку ничего не было сказано.
Может так? [vba]
Код
Sub readFile() Dim MyFile, i& MyFile = Split(CreateObject("Scripting.FileSystemObject").Getfile("C:\Downloads\MicExcel\7348509.txt").OpenasTextStream(1).ReadAll, "РєРѕРЅРµС")
For i = 1 To UBound(MyFile) - 1 Cells(i, 3) = WorksheetFunction.Trim( _ WorksheetFunction.Clean( _ Replace( _ Replace( _ Replace( _ MyFile(i) _ , vbLf, " ") _ , vbCr, " ") _ , vbTab, " ") _ )) Next End Sub