Макрос для передачи персанальных данных

[Evroclidon]

Я, студент,по специальности защита информации, пишу диплом, по защите персональных данных в пенсиооном фонде. Для удобстава передачи персональных данных хочу представить макрос, но в програмировании слаб. Вы мне уже помогали, дали этот код:
Sub Create_TXT_Files()
Dim fso As Object, rCell As Range
With CreateObject("Scripting.FileSystemO bject")
For Each rCell In Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
If rCell <> "" Then Set fso = .CreateTextFile("C:\" & rCell & ".txt", True)
Next rCell
End With
End Sub

Этот код создает txt документы, с названиями из содержимого ячеек столбца "А", пока ячейка не пуста. Помогите пожалуйста усложнить код, так что бы название документа состояла четко из содержимого ячек А,B,С.(в этих ячейках ФИО) в строке, и документы создавались до пустой строки. Плюс, макрос должен закидывать все содержимое строки, в созданный им документ из ячеек "А,В,С,D....n". В результате из эллектронной таблице с пенсионными данными, в которой записаны ФИО в ячейках A,B,C, и с другими данными, после запуска макроса, мы должны получить столько txt документов, с названием ФИО клиента и содережимым из строки присущей клиенту в диапозоне A,B,C...n, сколько таких клиентов у нас вбито в данную таблицу.

Еще нужен второй макрос, который наоборот, из txt документов, переносит все содержимое в эллектронную таблицу.

[Pavel55]

Я вот тут написал, но через цикл, может кто подскажет, как без цикла сделать? (цикл по столбцам от А до J, комментарии в коде )

Sub Create_TXT_Files()
    Dim fso As Object, rCell As Range, fsoTextStream As Object, icol As Long
    Dim iArr As String
        
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    For Each rCell In Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
        If rCell <> "" Then
            Set fsoTextStream = fso.CreateTextFile("C:\Temp\" & rCell & " " & rCell.Offset(, 1) & " " & rCell.Offset(, 2) & ".txt", True)
            
            'кто знает, как сделать без цикла? Чтобы данные в текстовом файле были через точку с запятой
            'типа так:
            'Dim iArr As Variant, rRange As Range
            'Set rRange = Range(Cells(rCell.Row, "A"), Cells(rCell.Row, "J"))
            'iArr = Application.Transpose(Application.Transpose(rRange))
            'тут надо в массиве iArr заменить vbCrLf на точку с запятой
            'типа  iArr = Replace(iArr, vbCrLf, ";")
            'и выводим данные в текстовый файл
            'fsoTextStream.WriteLine Join(iArr)
            
            'через цикл
            iArr = ""
            For icol = 1 To 10 'с первого столбца (А) до 10 (J)
                iArr = iArr & Cells(rCell.Row, icol) & ";"
            Next
            fsoTextStream.WriteLine iArr
            fsoTextStream.Close
        End If
    Next rCell
    MsgBox "Текстовые файлы созданы!", 64, ""
End Sub

[Evroclidon]

попробую)) спасибо

[Evroclidon]

а может лучше каждую ячейку копировать в новую страку? что бы потом не было затруднений в обратном програмном переводе, из txt в эксель

[Evroclidon]

вот тут внимание обратите,
Set fsoTextStream = fso.CreateTextFile("C:\Temp\" & rCell & " " & rCell.Offset(, 1) & " " & rCell.Offset(, 2) & ".txt", True)
если папки Temp нет, то будет ошибка. поэтому гадо указывать сушествующей адрес.

[Pavel55]

1) это не лучшая идея копировать каждую ячейку копировать в новую строку

2) про путь сохранения C:\Temp\ - укажите свой путь (я тестировал макрос и у меня файлы сохранялись в C:\Temp)

3) Если вы посмотрите текстовый файл, там каждое значение ячейки отделяется точкой с запятой. В связи с этим вы можете открыть этот текстовый файл в Excel (меню Файл - Открыть...), в открывшемся окошке выбрать "Тип файлов: Текстовые файлы (*.prn, *.txt, *.csv), щёлкните на название файла и нажмите кнопку "Открыть".
У вас откроется окошко "Мастер текстов (импорт) - шаг 1 из 3"
- выберите "с разделителями" и нажмите Далее
откроется "Мастер текстов (импорт) - шаг 2 из 3"
- укажите символ-разделитель "точка с запятой" и нажмите Далее
откроется "Мастер текстов (импорт) - шаг 3 из 3"
- нажмите Готово

[The_Prist]

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

Я вот тут написал, но через цикл, может кто подскажет, как без цикла сделать? (цикл по столбцам от А до J, комментарии в коде )[/CODE]

Оно?

Sub Create_TXT_Files()
    Dim fso As Object, rCell As Range, fsoTextStream As Object, icol As Long
    Dim iArr
        
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    For Each rCell In Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
        If rCell <> "" Then
            Set fsoTextStream = fso.CreateTextFile("C:\Temp\" & rCell & " " & rCell.Offset(, 1) & " " & rCell.Offset(, 2) & ".txt", True)

            iArr = Range(Cells(rCell.Row, "A"), Cells(rCell.Row, "J"))
            fsoTextStream.WriteLine Join(Application.Transpose(Application.Transpose(iArr)), ";")
            fsoTextStream.Close
        End If
    Next rCell
    MsgBox "Текстовые файлы созданы!", 64, ""
End Sub

[Evroclidon]

Этот проще)) а наоборот, из кучи подобных txt в ексель, как будет?

[Evroclidon]

а на веб мани можно же просто из терминал кинуть?

[The_Prist]

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

Этот проще)) а наоборот, из кучи подобных txt в ексель, как будет?

Кардинально измениться код. Необходимо отрыть определённые файлы или они заранее неизвестны? Можно выбирать файлы через диалоговое окно или просто записать в массив имена файлов и затем их обрабатывать по очереди.
Записывать данные из .txt-файлов как? Разделитель известен? Записывать новую книгу или уже имеющуюся? Все файлы на один лист?