Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Создание массива многострочных текстов - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Создание массива многострочных текстов (Макросы/Sub)
Создание массива многострочных текстов
YHOU Дата: Четверг, 11.02.2016, 10:51 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
Граждане помогите решить задачу.
Есть таблица с многострочными данными в столбце. Есть макрос сохраняющий эти данные в .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    ' считываем данные в массив
[/vba]

Автор - YHOU
Дата добавления - 11.02.2016 в 10:51
китин Дата: Четверг, 11.02.2016, 11:03 | Сообщение № 2
Группа: Модераторы
Ранг: Экселист
Сообщений: 7013
Репутация: 1073 ±
Замечаний: 0% ±

Excel 2007;2010;2016
есть у макроса начало, нет у макроса конца .и не будет? без файла . не? yes


Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852
 
Ответить
Сообщениеесть у макроса начало, нет у макроса конца .и не будет? без файла . не? yes

Автор - китин
Дата добавления - 11.02.2016 в 11:03
SLAVICK Дата: Четверг, 11.02.2016, 11:05 | Сообщение № 3
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
Ваш кусок кода ниочем.
Без примера - совет:
Используйте символы переноса строк VBLF, VBCR... и читайте эту тему (2-й пример)


Иногда все проще чем кажется с первого взгляда.
 
Ответить
СообщениеВаш кусок кода ниочем.
Без примера - совет:
Используйте символы переноса строк VBLF, VBCR... и читайте эту тему (2-й пример)

Автор - SLAVICK
Дата добавления - 11.02.2016 в 11:05
YHOU Дата: Четверг, 11.02.2016, 11:10 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
Ну можно и целиком:
[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$

        ' формируем имя создаваемого текстового файла
        Filename$ = Folder$ & Trim(arr(i, 3)) & ".txt"

        ' создаём файл в кодировке 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$

        ' формируем имя создаваемого текстового файла
        Filename$ = Folder$ & Trim(arr(i, 3)) & ".txt"

        ' создаём файл в кодировке 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]

Нашел его не просторах интернета.

Автор - YHOU
Дата добавления - 11.02.2016 в 11:10
Апострофф Дата: Четверг, 11.02.2016, 11:23 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 444
Репутация: 122 ±
Замечаний: 0% ±

Excel 1997
Проблему ТС я понимаю так - в 20-м (или 10-м?) столбце установлен формат Переносить по словам
В ячейках длинные тексты в одну строку, а не многострочные данные
В итоге очень хочется насовать туда с заданным интервалом VBCRLF'ы...
Как-то так %)


Сообщение отредактировал Sclif666 - Четверг, 11.02.2016, 11:51
 
Ответить
СообщениеПроблему ТС я понимаю так - в 20-м (или 10-м?) столбце установлен формат Переносить по словам
В ячейках длинные тексты в одну строку, а не многострочные данные
В итоге очень хочется насовать туда с заданным интервалом VBCRLF'ы...
Как-то так %)

Автор - Апострофф
Дата добавления - 11.02.2016 в 11:23
YHOU Дата: Четверг, 11.02.2016, 12:00 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
Как раз многострочный:
http://joxi.ru/LmGVv3JIRbbz4r
а получается так:
http://joxi.ru/Dr8KVnZtknnLwA
пробовал заменить на ";" - тоже не вариант:
http://joxi.ru/KAxea5xc4qqpyr


Сообщение отредактировал YHOU - Четверг, 11.02.2016, 12:06
 
Ответить
СообщениеКак раз многострочный:
http://joxi.ru/LmGVv3JIRbbz4r
а получается так:
http://joxi.ru/Dr8KVnZtknnLwA
пробовал заменить на ";" - тоже не вариант:
http://joxi.ru/KAxea5xc4qqpyr

Автор - YHOU
Дата добавления - 11.02.2016 в 12:00
YHOU Дата: Четверг, 11.02.2016, 12:16 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
Решено!!!!!!!!
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]


Сообщение отредактировал YHOU - Четверг, 11.02.2016, 12:24
 
Ответить
СообщениеРешено!!!!!!!!
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]

Автор - YHOU
Дата добавления - 11.02.2016 в 12:16
Апострофф Дата: Четверг, 11.02.2016, 12:27 | Сообщение № 8
Группа: Проверенные
Ранг: Обитатель
Сообщений: 444
Репутация: 122 ±
Замечаний: 0% ±

Excel 1997
Цитата
txt = Replace(txt, vbNewLine, vbCrLf)
- меняем шило на мыло тоже самое шило. :D
 
Ответить
Сообщение
Цитата
txt = Replace(txt, vbNewLine, vbCrLf)
- меняем шило на мыло тоже самое шило. :D

Автор - Апострофф
Дата добавления - 11.02.2016 в 12:27
YHOU Дата: Четверг, 11.02.2016, 12:38 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
Согласен, но все же... clap
 
Ответить
СообщениеСогласен, но все же... clap

Автор - YHOU
Дата добавления - 11.02.2016 в 12:38
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Создание массива многострочных текстов (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!