Преобразование выгрузки в CSV

[Yuri Toropchin]

Есть текстовый файл выгрузки вида:

CFullName: тексттексттексттекст
CShortName:тексттексттексттекст
CPhone:тексттексттексттекст
CFax:тексттексттексттекст
CZip:тексттексттексттекст
CEmail:тексттексттексттекст
CTelex:тексттексттексттекст
CAddress:тексттексттексттекст
CTopic:тексттексттексттекст
CFCDate:тексттексттексттекст
CFCPlace:тексттексттексттекст
CAccManager:тексттексттексттекст
CSize:тексттексттексттекст
CMainPur:тексттексттексттекст
Author:тексттексттексттекст
CCountry:тексттексттексттекст
CRegion:тексттексттексттекст
CCity:тексттексттексттекст
CCategory:тексттексттексттекст
CRelType:тексттексттексттекст
CRelState:тексттексттексттекст
CImp:тексттексттексттекст
cfn:тексттексттексттекст
csn:тексттексттексттекст
$UpdatedBy:тексттексттексттекст

После этого пять пустых строк и опять перечисление этих полей (иногда полей больше) с их значениями. И так далее. Всего где то 45 тысяч строк.

Необходимо преобразовать в CSV файл, с возможностью выбора столбцов (ненужные не запоминать).

[Hugo121]

Открыть в Экселе, разбить по столбцам по двоеточию, сохранить в формате csv.
Если нужно что-то другое - с Вас два файла - что есть и как надо.

[Yuri Toropchin]

Открыть в Экселе, разбить по столбцам по двоеточию, сохранить в формате csv.
Если нужно что-то другое - с Вас два файла - что есть и как надо.

Нужен такой вид такой вид:

Первая строка - CFullName,CshortName,CPhone,CFax,CZ ip,CEmail,CTelex,CAdress,CTopic,CAc cManager,CCountry,CRegion,CCity,CCa tegory,CRelType,CRelState

Последующие строки содержать перечисление значений соответственно первой строке -
текст1,текст2,текст3,текст4,текст5 и т.д.


Я написал такой макрос, но он берет только одну ячейку:

Sub тест()

Sheets("current").Activate
x = InputBox("введите искомое значение")
c = Cells.Find(What:=x).Column
r = Cells.Find(What:=x).Row
f = Cells(r, c + 1).Value
y = 1
Sheets("new").Activate
Cells(2, y).Value = f
y = y + 1

End Sub

[Hugo121]

Ну в общем так я и преполагал... Но вдруг не так нужно
Сделать можно, нужны массивы-словари-коллекции, и можно сделать без Экселя (скриптом wsh/vbs).
Но работы минимум на час, на работе столько свободного времени нет. Сверхурочно вечером в выходной работать неохота...
Да и примеры файлов обязательны. Правда с 100% предоплатой могу сделать на своих, но без гарантии на Ваших

[Yuri Toropchin]

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

Ну в общем так я и преполагал... Но вдруг не так нужно
Сделать можно, нужны массивы-словари-коллекции, и можно сделать без Экселя (скриптом wsh/vbs).
Но работы минимум на час, на работе столько свободного времени нет. Сверхурочно вечером в выходной работать неохота...
Да и примеры файлов обязательны. Правда с 100% предоплатой могу сделать на своих, но без гарантии на Ваших

Я не размещал тему в разделе фриланс Не могли бы вы дать совет как мне изменить мой макрос, чтобы он сохранял все найденные ячейки в массив для начала.

[Hugo121]

Не, Ваш макрос не знаю как изменить, я алгоритм вижу совершенно другим - разбить текст в массив (ну или можно его читать построчно), перебрать построчно собирая коллекцию названий столбцов и словарь группа/название+значение.
Затем цикл в цикле по коллекции, из словаря берём значение и пишем в строку в файл. Всё в общем. Час на реализацию.

[Hugo121]

Заготовка:

Sub tt()
    Dim a, arr, cnt&, i&, ii&, col As New Collection, out, s$, t$
    a = Split(CreateObject("Scripting.FileSystemObject").Getfile("e:\Tmp\test.txt").OpenasTextStream(1).ReadAll, vbNewLine)

    On Error Resume Next
    With CreateObject("scripting.dictionary"): .comparemode = 1
        For i = 0 To UBound(a)

            If Len(a(i)) > 0 Then
                If Len(a(i - 1)) = 0 Then cnt = cnt + 1
            End If

            If InStr(a(i), ":") Then
                arr = Split(a(i), ":", 2): col.Add arr(0), arr(0)
                .Item(cnt & "|" & arr(0)) = arr(1)
            End If
        Next

        Set out = CreateObject("Scripting.FileSystemObject").CreateTextFile("e:\Tmp\test.csv", 2, True)

        For i = 1 To col.Count
            s = s & ";" & col(i)
        Next
        out.WriteLine Mid(s, 2)

        For ii = 1 To cnt
            s = ""
            For i = 1 To col.Count
                t = ii & "|" & col(i)
                If .exists(t) Then s = s & ";" & .Item(t) Else s = s & ";"
            Next
            out.WriteLine Mid(s, 2)
        Next
        out.Close
    End With
End Sub

Точно час нужен чтоб шлифануть на файлах, а если ещё выбор столбцов добавлять - то полтора.

[alex77755]

Если нужно что-то другое - с Вас два файла - что есть и как надо.

Образца файла нет
Слепил из "того, что было"(во вложении)
Запустить, выбрать что надо, нажать "Сделать".
Рядом будет csv

[Hugo121]

Alex, не работает
Т.е. конечно работает, но на таких данных не понять, что именно оно туда лепит...
Анализ показал что всюду лепит первую группу.

[alex77755]

Не могу согласиться. Вроде выбранные выдаёт