Граждане помогите решить задачу. Есть таблица с многострочными данными в столбце. Есть макрос сохраняющий эти данные в .txt файлы. Единственное - он многострочный текст склеивает в одну строку. В итоге в .txt одна длиннющая строка. Как создать массив из ячеек с заполнением именно многострочным текстом? начало макроса такое: [vba]
Код
Dim cell As Range, ra As Range Set ra = Range([A2], Range("A" & Rows.Count).End(xlUp)).Resize(, 31) arr = ra.Value ' считываем данные в массив
[/vba]
Граждане помогите решить задачу. Есть таблица с многострочными данными в столбце. Есть макрос сохраняющий эти данные в .txt файлы. Единственное - он многострочный текст склеивает в одну строку. В итоге в .txt одна длиннющая строка. Как создать массив из ячеек с заполнением именно многострочным текстом? начало макроса такое: [vba]
Код
Dim cell As Range, ra As Range Set ra = Range([A2], Range("A" & Rows.Count).End(xlUp)).Resize(, 31) arr = ra.Value ' считываем данные в массив
Sub СозданиеТекстовыхФайлов() On Error Resume Next Dim cell As Range, ra As Range Set ra = Range([A2], Range("A" & Rows.Count).End(xlUp)).Resize(, 31) arr = ra.Value ' считываем данные в массив
Set FSO = CreateObject("scripting.filesystemobject") ' создаём главную папку BaseFolder$ = ThisWorkbook.Path & "\Товар по группам\": MkDir BaseFolder$
' перебираем все строки For i = LBound(arr) To UBound(arr) ' создаём папку для очередной строки (если папки ещё нет) Folder$ = BaseFolder$ & arr(i, 21) & "\" ' имя папки - в столбце G MkDir Folder$
' создаём файл в кодировке Unicode Set ts = FSO.CreateTextFile(Filename$, True, True) ts.Write (arr(i, 20)) ' данные в файл - из ячейки 10-го столбца ts.Close
Next i
Set ts = Nothing: Set FSO = Nothing MsgBox "Файлы созданы, и помещены в папку" & vbNewLine & BaseFolder$, vbInformation, "Готово"
' открываем папку с файлами CreateObject("wscript.shell").Run "explorer.exe /e, """ & BaseFolder$ & """" End Sub
[/vba]
Нашел его не просторах интернета.
Ну можно и целиком: [vba]
Код
Sub СозданиеТекстовыхФайлов() On Error Resume Next Dim cell As Range, ra As Range Set ra = Range([A2], Range("A" & Rows.Count).End(xlUp)).Resize(, 31) arr = ra.Value ' считываем данные в массив
Set FSO = CreateObject("scripting.filesystemobject") ' создаём главную папку BaseFolder$ = ThisWorkbook.Path & "\Товар по группам\": MkDir BaseFolder$
' перебираем все строки For i = LBound(arr) To UBound(arr) ' создаём папку для очередной строки (если папки ещё нет) Folder$ = BaseFolder$ & arr(i, 21) & "\" ' имя папки - в столбце G MkDir Folder$
' создаём файл в кодировке Unicode Set ts = FSO.CreateTextFile(Filename$, True, True) ts.Write (arr(i, 20)) ' данные в файл - из ячейки 10-го столбца ts.Close
Next i
Set ts = Nothing: Set FSO = Nothing MsgBox "Файлы созданы, и помещены в папку" & vbNewLine & BaseFolder$, vbInformation, "Готово"
' открываем папку с файлами CreateObject("wscript.shell").Run "explorer.exe /e, """ & BaseFolder$ & """" End Sub
Проблему ТС я понимаю так - в 20-м (или 10-м?) столбце установлен формат Переносить по словам В ячейках длинные тексты в одну строку, а не многострочные данные В итоге очень хочется насовать туда с заданным интервалом VBCRLF'ы... Как-то так
Проблему ТС я понимаю так - в 20-м (или 10-м?) столбце установлен формат Переносить по словам В ячейках длинные тексты в одну строку, а не многострочные данные В итоге очень хочется насовать туда с заданным интервалом VBCRLF'ы... Как-то так Апострофф
Сообщение отредактировал Sclif666 - Четверг, 11.02.2016, 11:51
Решено!!!!!!!! SLAVICK, Sclif666, спасибо за помощь! решилось так: [vba]
Код
Set ts = FSO.CreateTextFile(Filename$, True, True) txt = Trim(arr(i, 20)) 'Данные в файл из ячейки 20-го столбца txt = Replace(txt, vbNewLine, vbCrLf) ' заменяем Последовательность символов перехода на новую строку на Сочетание символов возврата каретки и перевода строки. txt = Replace(txt, vbLf, vbCrLf) ' заменяем Символ перевода строки на Сочетание символов возврата каретки и перевода строки. ts.Write txt ' Пишем текстовое значение в файл ts.Close
[/vba]
Решено!!!!!!!! SLAVICK, Sclif666, спасибо за помощь! решилось так: [vba]
Код
Set ts = FSO.CreateTextFile(Filename$, True, True) txt = Trim(arr(i, 20)) 'Данные в файл из ячейки 20-го столбца txt = Replace(txt, vbNewLine, vbCrLf) ' заменяем Последовательность символов перехода на новую строку на Сочетание символов возврата каретки и перевода строки. txt = Replace(txt, vbLf, vbCrLf) ' заменяем Символ перевода строки на Сочетание символов возврата каретки и перевода строки. ts.Write txt ' Пишем текстовое значение в файл ts.Close