1

Тема: VBA: Перенос данных из Excel в цикле

Добрый день!
Помогите решить следующую задачку.
1. Имеется файл excel.xlsx, содержащий 5 столбцов и переменное количество строк.
2. Скрипт должен взять значение из ячейки A1 и создать папку с таким именем.
3. В созданной папке создать файл file.txt.
4. Содержимое файла file.txt будет иметь формат "текст A2 текст A3 текст A4 текст A5".
5. Вместо A2, A3, A4 и A5 подставить значения из одноименных ячеек файла excel.xlsx.
6. Скрипт должен считать количество строк и выполнить цикл 2-5 столько раз, сколько строк в файле excel.xlsx

2

Re: VBA: Перенос данных из Excel в цикле

Как быть, если значения в столбце A повторятся?

3

Re: VBA: Перенос данных из Excel в цикле

Хмм.. это я не учел...
Хотя это не принципиально, т.к. в столбце A - наименование продукции (маркировка запчастей) и оно не должно повторяться, так что ничего страшного, если папка перезапишется.
А возможно дописать в название папки "-1", потом "-2" и т.д. при повторяющихся значениях?

4

Re: VBA: Перенос данных из Excel в цикле

Теперь разъясните по поводу:

"текст A2 текст A3 текст A4 текст A5".

Не «B1+C1+D1+E1»? Если — нет, выкладывайте упакованный образец документа на RGhost.ru.

5

Re: VBA: Перенос данных из Excel в цикле

"текст A2 текст A3 текст A4 текст A5".
"текст" - это заданный в явном виде текст, т.е. если в экселевском файле у нас массив:
11 12 13 14 15
21 22 23 24 25
31 32 33 34 35
...  ...  ...  ...  ...   и т.д., то

текстовый файл C:\...\11\file.txt  содержит "Наименование: 12; длина: 13; ширина: 14; высота: 15",
текстовый файл C:\...\21\file.txt  содержит "Наименование: 22; длина: 23; ширина: 24; высота: 25",
текстовый файл C:\...\31\file.txt  содержит "Наименование: 32; длина: 33; ширина: 34; высота: 35",
и т.д.

6 (изменено: Rom5, 2013-02-27 01:18:49)

Re: VBA: Перенос данных из Excel в цикле

NikNap пишет:

"текст A2 текст A3 текст A4 текст A5".
..
11 12 13 14 15
текстовый файл C:\...\11\file.txt  содержит "Наименование: 12; длина: 13; ширина: 14; высота: 15",

Видимо, имелось в виду - "текст B1; текст C1; текст D1; текст E1", т.е. одна строка (а не колонка) -> в один файл ?

Если можно писать в исходный файл, то содержимое будущих файлов можно сформировать заранее (формулой, для наглядности) в колонке, например, F, а в следующих колонках протоколировать результат работы скрипта.



Для начала макросом считывать в цикле количества рабочих строк значение из колонки A в переменную, приводить ее содержимое к требованиям применяемым к именам файлов (убрать-заменить всякие кавычки, спецсимволы, проконтролировать длину и т.п.), полученный путь для наглядности отладки сохранять в колонку G.

Оттестировав эту часть, дописать макрос файловыми операциями -  создать каталог с именем по значению из колонки G, создать текстовый файл с готовым содержимым из ячейки F, результат (успешно или нет создание каталога и файла) заносить в колонку H - потом будет легче понять, что и как должно было создасться и искать причину неудач.

WBR. Roman

7

Re: VBA: Перенос данных из Excel в цикле

Rom5 пишет:

Видимо, имелось в виду - "текст B1; текст C1; текст D1; текст E1", т.е. одна строка (а не колонка) -> в один файл ?

ДА, прошу прощения, ошибся.

8

Re: VBA: Перенос данных из Excel в цикле

Попробуйте так:


Sub Go()
    Me.Range("A1").Activate
    Set fso = CreateObject("Scripting.FileSystemObject")
    i = 0
    Do Until ActiveCell.Value = ""
        MsgBox ActiveCell.Value
        folder = ActiveCell.Value
        If Not fso.FolderExists(folder) Then fso.CreateFolder (folder)
        file = folder & "\file.txt"
        Set f = fso.OpenTextFile(file, 8, True)
        s = ActiveCell.Offset(0, 1).Value & ";" & ActiveCell.Offset(0, 2).Value & ";" & _
                ActiveCell.Offset(0, 3).Value & ";" & ActiveCell.Offset(0, 4).Value
        f.WriteLine (s)
        f.Close
        i = i + 1
        ActiveCell.Offset(1, 0).Activate
    Loop
    Set fso = Nothing
    MsgBox "Обработано строк: " & i
End Sub

Код должен быть в модуле листа.

9

Re: VBA: Перенос данных из Excel в цикле

NikNap, ну, вот как-то так:

Option Explicit

Sub SomeProcExport()
    Dim objFSO As Object
    Dim objRow As Range
    Dim strFolder As String
    Dim i As Long
    
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    For Each objRow In ThisWorkbook.ActiveSheet.UsedRange.Rows
        strFolder = objFSO.BuildPath(ThisWorkbook.Path, objRow.Cells(1, 1).Value)
        
        i = 1
        
        Do While objFSO.FolderExists(strFolder)
            i = i + 1
            strFolder = objFSO.BuildPath(ThisWorkbook.Path, objRow.Cells(1, 1).Value & " (" & CStr(i) & ")")
        Loop
        
        Debug.Print strFolder
        
        objFSO.CreateFolder strFolder
        
        With objFSO.CreateTextFile(objFSO.BuildPath(strFolder, "file.txt"), True, True)
            .WriteLine _
                "Наименование: " & objRow.Cells(1, 2).Value & "; " & _
                "длина: " & objRow.Cells(1, 3).Value & "; " & _
                "ширина: " & objRow.Cells(1, 4).Value & "; " & _
                "высота: " & objRow.Cells(1, 5).Value
            
            .Close
        End With
    Next
    
    Set objFSO = Nothing
End Sub

в первом приближении.

Путь берётся равным пути документа. Целевым листом считается активный рабочий лист.

Имейте в виду, что, в соответствии с высказанными пожеланиями, повторный запуск приведёт к созданию второго экземпляра папок.

10

Re: VBA: Перенос данных из Excel в цикле

Огромное спасибо.
Вариант от  alexii работает прекрасно.
Вариант от dab00, к сожалению, ругается на 2-ю строку (Invalid use of Me keyword)

11

Re: VBA: Перенос данных из Excel в цикле

alexii, скажите, пожалуйста, как сделать так, чтоб файл сохранялся в кодировке UTF-8?

12

Re: VBA: Перенос данных из Excel в цикле

Примерно так:

Option Explicit

Sub SomeProcExport()
    Dim objFSO As Object
    Dim objRow As Range
    Dim strFolder As String
    Dim i As Long
    
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    For Each objRow In ThisWorkbook.ActiveSheet.UsedRange.Rows
        strFolder = objFSO.BuildPath(ThisWorkbook.Path, objRow.Cells(1, 1).Value)
        
        i = 1
        
        Do While objFSO.FolderExists(strFolder)
            i = i + 1
            strFolder = objFSO.BuildPath(ThisWorkbook.Path, objRow.Cells(1, 1).Value & " (" & CStr(i) & ")")
        Loop
        
        objFSO.CreateFolder strFolder
        
        With objFSO.CreateTextFile(objFSO.BuildPath(strFolder, "file.txt"), True, False)
            .WriteLine StrConvert( _
                "Наименование: " & objRow.Cells(1, 2).Value & "; " & _
                "длина: " & objRow.Cells(1, 3).Value & "; " & _
                "ширина: " & objRow.Cells(1, 4).Value & "; " & _
                "высота: " & objRow.Cells(1, 5).Value, _
                "UTF-8", "Windows-1251")
            
            .Close
        End With
    Next
    
    Set objFSO = Nothing
End Sub

Function StrConvert(strValue As String, strSourceCharset As String, strDestCharset As String)
    Const adTypeText As Integer = 2
    Const adModeReadWrite As Integer = 3
    
    With CreateObject("ADODB.Stream")
        .Type = adTypeText
        .Mode = adModeReadWrite
        
        .Open
        
        .Charset = strSourceCharset
        .WriteText strValue
        
        .Position = 0
        .Charset = strDestCharset
        
        StrConvert = .ReadText
    End With
End Function

13

Re: VBA: Перенос данных из Excel в цикле

Так каждая строчка в кодировке UTF-8, но сам файл в юникоде. А как сделать так, чтоб файл сохранялся в UTF-8?

14

Re: VBA: Перенос данных из Excel в цикле

но сам файл в юникоде.

Нет:

With objFSO.CreateTextFile(objFSO.BuildPath(strFolder, "file.txt"), True, False)

15

Re: VBA: Перенос данных из Excel в цикле

Сорри, не заметил. Спасибо. Все работает.