Экспорт rtf в Excel

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

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

11.03.2013 03:45:14

Здравствуйте.
Подскажите, пожалуйста, макрос для переноса файла в формате rtf в Excel .

Вот в этом топике http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=8&TID=18960
я взяла макрос

мой компьютер ругается "run time error..." вроде бы на вот эту строку макроса (подсвечивает желтым).
Value = Application.Transpose(Arr)
Как поправить правильно эту строку я не знаю, поискала ещё в интернете.

Нашла вот такой макрос

Скрытый текст

Пробовала его запустить, безрезультатно.

Ещё один вопрос, макрос для rtf подойдет для txt ?
Спасибо заранее.

EducatedFool

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

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

11.03.2013 05:40:08

Здравствуйте, Галина.

1) Я не нашел в вашем макросе строку Value = Application.Transpose(Arr)
А ругается, скорее всего, потому, что массив Arr - пустой.
(видимо, данные не загрузились)

2) Макрос для txt, конечно, можно приспособить,
но зачем мучить Word обработкой текстовых файлов,
когда данные из файла TXT намного проще и быстрее загрузить напрямую, не запуская Word.

Вот несколько примеров макросов для чтения текстовых файлов из Excel:
http://excelvba.ru/code/txt
http://excelvba.ru/code/CSV2Excel
http://excelvba.ru/code/TextFile2Array
http://excelvba.ru/programmes/TemperaturesFromTextFile
http://excelvba.ru/programmes/Notepad

Надстройки для Excel Парсинг сайтов Мониторинг цен конкурентов

Galina_27

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

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

11.03.2013 08:06:48

Добрый день.
Игорь, спасибо за ответ.
Вечером попробую Ваши коды.

Честно говоря, я в VBA ничего не понимаю, с необходимостью применить макросы столкнулась буквально в прошлом месяце, подыскиваю себе понятную литературу, немного читала Гарнаева.

Насчет моих вопросов.
Вопрос №2 я немного некорректно сформулировала, имелось в виду, подойдет ли макрос, импортирующий из rtf в Excel для такой же цели для файла в формате txt (импорта txt в Excel)

Вопрос №1
Вот такой макрос я пыталась запустить, автор KuklP
' ZVI:2009-09-02 http://www.planetaexcel.ru/forum.php?thread_id=9631

Скрытый текст

' Импорт строк в Excel из RTF
Sub ToExcelFromWord()

' --> Менять только здесь
Const MyFile = "C:\1.rtf" ' <-- Путь, имя, тип файла RTF
Const Destination = "J4" ' <-- Адрес первой ячейки импорта
' <--

Dim wdApp As Object, wdDoc As Object, IsNewApp As Boolean
Dim txt$, i&, Arr, wdWSm, x

' Открыть RTF
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err <> 0 Then
Err.Clear
Set wdApp = CreateObject("Word.Application")
IsNewApp = True
Else
With wdApp
i = .Documents.Count
.ScreenUpdating = False
wdWS = .WindowState
If wdWS <> 0 Then .WindowState = 0
End With
End If
Set wdDoc = wdApp.Documents.Open(MyFile, , True)
If Err <> 0 Then MsgBox "Не найден файл: " & MyFile, vbExclamation: Err.Clear: GoTo exit_
On Error GoTo 0 'exit_

' Скопировать из Word в масссив Arr
txt = wdDoc.Content
txt = Replace(wdDoc.Range.Text, Chr(7), "")
Arr = Split(txt, vbCr)
' Заморозить Excel
With Application
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
' Скопировать из масссива Arr - в Excel
With Range(Destination)
' Очистить
Set x = Cells(Rows.Count, .Column).End(xlUp)
If x.Row >= .Row Then Range(.Offset(0), x).ClearContents
' Скопировать
With .Resize(UBound(Arr), 1)
.NumberFormat = "@"
.Font.Name = "Courier New"
.Font.Size = 10
.Value = Application.Transpose(Arr)
.Columns.AutoFit
End With
End With

exit_:
' Поймать ошибку
If Err <> 0 Then MsgBox Err.Description
' Закрыть RTF
wdDoc.Close 0
Set wdDoc = Nothing
' Закрыть приложение Word или оживить его (если ранее был открыт)
With wdApp
If IsNewApp Then
.Quit
Else
If .Documents.Count < i Then .Documents.Add
.WindowState = wdWS
.ScreenUpdating = True
End If
End With
Set wdApp = Nothing
' Отморозить Excel
With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

KuklP

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

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

E-mail и реквизиты в профиле.

11.03.2013 08:29:25

Цитата
Galina_27 пишет: автор KuklP

Вот те раз! C чего Вы взяли? Я в той теме даже не участвовал

Автор Владимир Захаров, ZVI.

Я сам - дурнее всякого примера! ...

ZVI Пользователь Сообщений: 4620 Регистрация: 23.12.2012	#5 11.03.2013 12:54:11 Галина, можете приложить пример файла, содержимое которого нужно скопировать в Excel?

SvetaS_love

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

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

26.09.2015 21:37:46

Добрый Вечер! У меня аналогичная проблема. Игорь,у меня не срабатывает Ваша функция по ссылке TextFile2Array

т.е. массив arr - остаётся пустым. Т.е. не проходит разделение файла по столбцам

Прикрепленные файлы

file1.CSV (4 КБ)
ошибка1.gif (45.79 КБ)

Изменено: SvetaS_love - 26.09.2015 21:46:47

одинокий странник

SvetaS_love

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

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

26.09.2015 21:45:45

может быть кто-то сможет подсказать как перевести функцию

Код

Private Sub
Button1_Click(ByVal
sender As System.Object, ByVal
e As System.EventArgs)
Handles Button1.Click

        Dim Mass()

        Dim STR As String

        Mass = IO.File.ReadAllLines("D:\1.csv")

        STR = Split(Mass(2), ",")(3)

        MsgBox(STR)

    End Sub

на VBA Excel
меня интересует именно строка

Код
Mass = IO.File.ReadAllLines("D:\1.csv")

Изменено: SvetaS_love - 26.09.2015 21:49:42

одинокий странник

SvetaS_love

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

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

26.09.2015 21:52:55

т.е. я пишу

Код

Dim nn As Long
Dim la() As String
Dim lr() As String
Dim n As String
nn = 1
    Const ForReading = 1, ForWriting = 2, ForAppending = 3
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
    Dim fs, f, ts, s
    Set fs = CreateObject("Scripting.FileSystemObject")
           
   Set f = fs.GetFile("D:\file.csv")
     
   Set ts = f.OpenAsTextStream(ForReading, TristateUseDefault)

но как вставить строку

Код
Mass = IO.File.ReadAllLines("D:\1.csv")

одинокий странник

SvetaS_love Пользователь Сообщений: 132 Регистрация: 14.07.2015	#9 26.09.2015 21:55:24 Задача описана в теме "RunTime Error 7 - Out of Memory" одинокий странник

SvetaS_love

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

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

#10

26.09.2015 22:15:43

запись в файл происходит тут (всё работает) , но как прочитать по столбцам в массив? Почему не срабатывает функция TextFile2Array c выгрузкой уже записанного ранее файла?

Код
Function txt_write_from_Mas(m As Variant, n%) Dim i#, ii#, s$ For i = 1 To UBound(m) s = m(i, 1) For ii = 2 To UBound(m, 2) s = s & vbTab & m(i, ii) Next Print #n, s ' Write #n, sf Next

одинокий странник

Kuzmich Пользователь Сообщений: 8201 Регистрация: 21.12.2012	#11 26.09.2015 22:17:49 Ваш файл открываете в Excel, а потом выделяете столбец А с данными и применяете текст по столбцам, разделитель - знак табуляции

SvetaS_love Пользователь Сообщений: 132 Регистрация: 14.07.2015	#12 26.09.2015 22:19:02 Kuzmich, а на языке VBA ? одинокий странник

SvetaS_love Пользователь Сообщений: 132 Регистрация: 14.07.2015	#13 26.09.2015 22:21:37 в файле 300 000 строк. Нужно быстро на VBA... одинокий странник

Kuzmich Пользователь Сообщений: 8201 Регистрация: 21.12.2012	#14 26.09.2015 22:27:35 Так дольше писать код VBA, чем выделить 300 000 строк и разделить по столбцам. Вот ваш файл c разделенными данными в формате .xls Прикрепленные файлы file1.xls (40 КБ)

Kuzmich

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

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

#15

26.09.2015 22:39:00

Цитата
Нужно быстро на VBA...

Посмотрите метод объекта Range TextToColumns

SvetaS_love Пользователь Сообщений: 132 Регистрация: 14.07.2015	#16 26.09.2015 22:39:08 Kuzmich, там задача расписана в теме "Задача описана в теме "RunTime Error 7 - Out of Memory"", а в ручную я и так каждую неделю делаю...нужен кусок кода, чтобы вставить его в другой кусок кода..... и .т.д. одинокий странник

SvetaS_love Пользователь Сообщений: 132 Регистрация: 14.07.2015	#17 26.09.2015 22:41:58 Kuzmich, ты вообще представляешь , что при считывании с каждой строки листа при объёме в 300 000 строк Excel просто повиснит? Зачем ты мне файл прислал без макроса? у меня его считывать некуда.... одинокий странник