сохранить каждую ячейку (столбца) в отдельный файл тхт

[kwike]

Помогите плиз.
Обыскал весь интернет, но не нашёл.
Хотя вру нашёл, но там второй человек сразу же задал якобы похожий вопрос, и ответа на первоначальный вопрос так никто и не дал(

Необходим макрос, чтоб сохранялось в файл (txt), содержимое каждой ячейки из столбца, при этом название файла из соседнего столбца (если содержимое ячеек:"название файла" и "содержимое файла" = пусто, то не сохранять в файл)
И желательно, чтоб макрос срабатывал при сохранении основного Эксель.

Пример Эксель:
"Имя файла1"; "содержимое файла1"
.......
"Имя файла100"; "содержимое файла100"

[kwike]

это мёртвый форум?( хотя бы "послали бы"

[Valick]

kwike, для Экселистов есть отдельный форум и отдельный котёл в аду.
Как бы вам мягко намекнуть, что сама постановка задачи заставляет здравомыслящих людей держаться от вас подальше.

[сфинкс]

внизу страницы похожие темы например

Открыть файл, разделить ячейку на 1000, сохранить файл, закрыть файл. Как?
https://www.programmersforum.ru/showthread.php?t=185703

но проверять макросы конечно же не буду

гораздо проще перевести таблицу в текстовый файл
и перерабатывать даже через устаревшие языки программирования

[macomics]

Сохранить как csv и в cmd выполнить bat файл следующего содержания

rem На вход необходимо передать имя csv файла в качестве первого параметра
set IDX=1
for /F "usebackq" %%I in (`type "%~f1"`) DO call :drop "%~n1" %IDX% "%%~I"
set IDX=
exit /b 0

:drop
if %2 LSS 10 (
  echo %~3 > %~1_000%2.txt
) else (
  if %2 LSS 100 (
    echo %~3 > %~1_00%2.txt
  ) else (
    if %2 LSS 1000 (
      echo %~3 > %~1_0%2.txt
    ) else (
      echo %~3 > %~1_%2.txt
    )
  )
)
set /a IDX=1+%2

Но не проверял. Напечатал в браузере. Опечатки исправите.

[jillitil]

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = True
    Строка = 1
    ПоследняяСтрока = 7
    Do
        C = Cells(Строка, 1)
        V = Cells(Строка, 2)
        If (C <> "") And (V <> "") Then
             Open "T:\" & C & ".TXT" For Output As #1
             Print #1, V
             Close #1
        End If
        Строка = Строка + 1
    Loop Until Строка > ПоследняяСтрока
End Sub

[kwike]

Function EncodeUTF8noBOM(ByVal txt As String) As String
    For i = 1 To Len(txt)
        l = Mid(txt, i, 1)
        Select Case AscW(l)
            Case Is > 4095: t = Chr(AscW(l) \ 64 \ 64 + 224) & Chr(AscW(l) \ 64) & Chr(8 * 16 + AscW(l) Mod 64)
            Case Is > 127: t = Chr(AscW(l) \ 64 + 192) & Chr(8 * 16 + AscW(l) Mod 64)
            Case Else: t = l
        End Select
        EncodeUTF8noBOM = EncodeUTF8noBOM & t
    Next
End Function
Sub макрос сохранения в файл()
' сочетание клавиш: Ctrl+q
    Cancel = True
    Cell = 1 ' первая строка
    LastCell = 99 ' последняя проверяемая строка на наличие текста
    Do
        C = Cells(Cell, 1) ' Вместо 1 вставить номер столбца, где хранится название файлов
        V = Cells(Cell, 2) ' Вместо 2 вставить номер столбца, где хранится содержимое файлов
        V = EncodeUTF8noBOM(V)
        If (C <> "") And (V <> "") Then
             Open "C:\Users\PC\Desktop" & C & ".TXT" For Output As #1
             Print #1, V
             Close #1
        End If
        Cell = Cell + 1
    Loop Until Cell > LastCell
End Sub

[shanemac51]

Сообщение от kwike

Open "C:\Users\PC\Desktop" & C & ".TXT" For Output As #1

надо заменять недопустимые символы в имени, например на подчеркивание

c1=c
c1=replace(c1,":","_")
c1=replace(c1,"\","_")
''''может и еще какие-то, особенно знаки препинания
Open "C:\Users\PC\Desktop" & C1 & ".TXT" For Output As #1