Страницы: 1
RSS
сохранение массива vba в несколько файлов по условию
 
Приветствую,
Подскажите пожалуйста как реализовать макросом подобное
Имеем табличку (рисунок 1)
В VBA формируем массив в память
a = [A1:F12]
как по ключевому полю Index сохранить данные в разные файлы csv
В итоге получить 3 файла
(название файла формируется из столбца А)
файл овощи.csv с товарами Index = 1
файл фрукты.csv  с товарами Index = 2
файл грибы.csv с товарами Index = 3
Пример файла овощи.csv
(рисунок 2)
Изменено: Антон - 21.01.2020 12:37:21
 
Если нужно из одного csv сделать несколько - можно обойтись без Экселя, можно скриптом. Просто переложить нужные строки. Чуть позже найду время.
 
Цитата
Hugo написал:
можно обойтись без Экселя, можно скриптом.
Да, я именно макросом и хочу это сделать.
Цитата
Hugo написал:
Чуть позже найду время.
Спасибо!
 
Код
Sub Main()
    Dim a As Variant
    With ActiveSheet
        a = .Range(.Cells(1, 1), .Cells(.Rows.Count, "F").End(xlUp))
    End With
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim y As Long
    For y = 2 To UBound(a, 1)
        Set dic.Item(a(y, 1)) = Nothing
    Next
    
    Dim v As Variant
    For Each v In dic.keys
        Set dic.Item(v) = fso.CreateTextFile(ThisWorkbook.Path & "\" & v & ".csv", True)
        dic.Item(v).WriteLine Join(Array(a(1, 1), a(1, 2), a(1, 3), a(1, 4), a(1, 5), a(1, 6)), ";")
    Next
    
    For y = 2 To UBound(a, 1)
        dic.Item(a(y, 1)).WriteLine Join(Array(a(y, 1), a(y, 2), a(y, 3), a(y, 4), a(y, 5), a(y, 6)), ";")
    Next
    
    For Each v In dic.keys
        dic.Item(v).Close
    Next
    
End Sub
 
Вот скрипт (практически макрос). Исходный файл положить как в нём прописано в "c:\Downloads\table.csv", результаты будут рядом. Запускать просто стандартно дабкликом по файлу. Если конечно работаете под Виндой и выпонение скриптов разрешено.
Для предыдущей темы этот скрипт не годится, тут работа только с такими csv!!!
Код
    Const ForReading = 1
    Const ForWriting = 2

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.OpenTextFile("c:\Downloads\table.csv", ForReading)

    strText = objFile.ReadAll
    objFile.Close
    a = Split(strText, vbNewLine)

    Set d = CreateObject("Scripting.Dictionary"): d.comparemode = 1
    For i = 1 To UBound(a)
        If Len(a(i)) Then
            t = Trim(Split(a(i), ";")(5))
            d.Item(t) = d.Item(t) & "|" & i
        End If
    Next

    For Each k In d.keys
        strText = a(0) & vbNewLine
        For Each el In Split(Mid(d.Item(k), 2), "|")
            strText = strText & a(el) & vbNewLine
        Next
        Set objFile = objFSO.CreateTextFile("c:\Downloads\" & k & ".csv", ForWriting)
        objFile.Write strText
        objFile.Close
    Next

Файл запаковал, незапакованный форум не принимает.
Изменено: Hugo - 21.01.2020 13:52:44
 
Благодарю! То что нужно
 
За минуту уже проверили? :)
Страницы: 1
Наверх