Приветствую, Подскажите пожалуйста как реализовать макросом подобное Имеем табличку (рисунок 1) В VBA формируем массив в память a = [A1:F12] как по ключевому полю Index сохранить данные в разные файлы csv В итоге получить 3 файла (название файла формируется из столбца А) файл овощи.csv с товарами Index = 1 файл фрукты.csv с товарами Index = 2 файл грибы.csv с товарами Index = 3 Пример файла овощи.csv (рисунок 2)
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
Файл запаковал, незапакованный форум не принимает.