Версия для печати темы

Нажмите сюда для просмотра этой темы в оригинальном формате

WinCity.Ru _ Microsoft/Office Excel _ из rtf в exel

Автор: clipsa Среда, 27 Февраля 2008, 16:30

Помогите пожалуйста.
Есть необходимость перенести таблицу из rtf в xls.

Проблема в том, что одна запись в rtf занимет несколько строк xls.
Как написать нечто типа скриптика (макроса)?
Попробовал вот так
Sub rtf()
For i = 1 To 1000
If a(i) <> 0 Then k(i) = b(i) + b(i + 1)
End Sub

но запускаться не хочет, я так понимаю нужно как-то указать что a,k,b это столбцы
Подскажите как сделатью

Автор: clipsa Среда, 27 Февраля 2008, 16:58

немного почитал help получилось так
Sub rtf_()

For I = 1 To 1000
If Worksheets(1).Range("A(i)") <> 0 Then Worksheets(2).Range("b(i)") = Worksheets(1).Range("B(i)") & Worksheets(1).Range("B(i)+1")
Next
End Sub
но при попытке запуска пишет
Run-time error '1004':
Application-defined or object-defined error
что не правильно?

Автор: clipsa Среда, 27 Февраля 2008, 17:19

Добавил Workbook

Sub rtf_()
For i = 1 To 1000
If Workbook.Worksheets(1).Range("A(i)").Value <> 0 Then Workbook.Worksheets(2).Range("b(i)").Value = Workbook.Worksheets(1).Range("B(i)").Value & Workbook.Worksheets(1).Range("B(i)+1").Value
Next i
End Sub

Теперь
Run-time error '424':
Object required

Подскажите как парвильно?
Очень надо.

Автор: clipsa Четверг, 28 Февраля 2008, 0:37

Всем спасибо!
Сделал сам

Автор: Барэль Четверг, 28 Февраля 2008, 2:12

Расскажи как, думаю людям будет интересно

Автор: clipsa Пятница, 29 Февраля 2008, 15:07

Sub rtf_new()
'
' rtf_new Макрос
' Макрос записан 27.02.2008 (Rommi)
'
' Сочетание клавиш: Ctrl+e
'
For i = 1 To 1000
If ActiveWorkbook.Worksheets(1).Rows(i).Cells(1).Value <> 0 Then ActiveWorkbook.Worksheets(2).Rows(i).Cells(1) = ActiveWorkbook.Worksheets(1).Rows(i).Cells(1) Else GoTo label1
If ActiveWorkbook.Worksheets(1).Rows(i).Cells(2).Value = 0 Then GoTo label1
ActiveWorkbook.Worksheets(2).Rows(i).Cells(2) = ActiveWorkbook.Worksheets(1).Rows(i).Cells(2) & ActiveWorkbook.Worksheets(1).Rows(i + 1).Cells(2)
label1:
Next i
Rem убираем пустые строки
j = 1
Do While j < 1001
If ActiveWorkbook.Worksheets(2).Rows(j).Cells(2).Value = 0 And ActiveWorkbook.Worksheets(2).Rows(j).Cells(1).Value = 0 Then ActiveWorkbook.Worksheets(2).Rows(j).Delete Shift:=xlUp
j = j + 1
Loop
End Sub