На листе есть постоянно увеличивающаяся таблица BV:BX В ней местами вписан разнообразный длинный текст. В шестой строке этого диапазона - находятся заголовки. В папке "1-1 4" рядом с книгой - лежат текстовые файлы имена которых идентичны названиям заголовков.
Как макросом - построчно сохранить текстовые записи таблицы - в соответствующие файлы txt, с игнорированием ячеек со значением "" ? (При каждом новом срабатывании макрос - перезаписывает заново содержимое текстовых файлов)
Здравствуйте. Помогите решить проблему.
На листе есть постоянно увеличивающаяся таблица BV:BX В ней местами вписан разнообразный длинный текст. В шестой строке этого диапазона - находятся заголовки. В папке "1-1 4" рядом с книгой - лежат текстовые файлы имена которых идентичны названиям заголовков.
Как макросом - построчно сохранить текстовые записи таблицы - в соответствующие файлы txt, с игнорированием ячеек со значением "" ? (При каждом новом срабатывании макрос - перезаписывает заново содержимое текстовых файлов)perven
Dim arr(), lr As Long, i As Long, j As Long Dim path As String
path = ThisWorkbook.path & "\" & "1-1 4"
For j = 74 To Cells(6, Columns.Count).End(xlToLeft).Column lr = Cells(Rows.Count, j).End(xlUp).Row If lr > 6 Then arr() = Range(Cells(6, j), Cells(lr, j)).Value Open path & "\" & arr(1, 1) & ".txt" For Output As #1 For i = 2 To UBound(arr) If arr(i, 1) <> "" Then Print #1, CStr(arr(i, 1)) End If Next i Close #1 End If Next j
MsgBox "Готово!", vbInformation
End Sub
[/vba]
[vba]
Код
Sub Записать_в_текстовые_файлы()
Dim arr(), lr As Long, i As Long, j As Long Dim path As String
path = ThisWorkbook.path & "\" & "1-1 4"
For j = 74 To Cells(6, Columns.Count).End(xlToLeft).Column lr = Cells(Rows.Count, j).End(xlUp).Row If lr > 6 Then arr() = Range(Cells(6, j), Cells(lr, j)).Value Open path & "\" & arr(1, 1) & ".txt" For Output As #1 For i = 2 To UBound(arr) If arr(i, 1) <> "" Then Print #1, CStr(arr(i, 1)) End If Next i Close #1 End If Next j