Преобразование в таблицу Excel текстового файла с CSV-разделителями.

Август 12, 2011 at 21:34 Оставьте комментарий

Нередко возникает такая ситуация: какая-либо СУБД, или почтовый клиент, или еще кто-нибудь имеет возможность экспорта таблицы, адресной книги и прочего только в txt и в какой-то внутренний формат. А хотелось бы иметь возможность выгружать в красивую табличку, чтобы потом послать кому-то по почте или просто распечатать. Есть простой выход: Excel прекрасно открывает txt, а дальше VB в руки и мы получаем то, что нам нужно.
Итак. Затаив дыхание, делаем Экспорт в текстовый файл.
Он будет выглядеть как-то так в случае СУБД:
1. ООО "Рога и копыта"
Телефон: 22233300
Адрес: Москва, Мясницкая ул., д.1
Производство: рога и копыта

2. ....
Или так:
1. Имя: Кристобаль
Фамилия: Хунта
email: нечто неведомое

2. ....

Очень все похоже, но основная неприятность в том, что по разным пунктам известно разное количество информации и соответственно поля разные и количество отведенных строк тоже разное. Но все преодолимо.
Открываем в Excel как файл с CSV-разделителями.
А дальше натравливаем на него макрос(он отрабатывается над текущим активным листом, так что стоит его создать в этой же книге).

Sub make_table()
Dim iSheet As Worksheet
Set iSheet = ActiveSheet   ' лист, содержащий выгрузку в txt
Set NewBook = Workbooks.Add ' новая книга, в которой будет таблица
    With NewBook
        .SaveAs Filename:=Application.GetSaveAsFilename( _
        fileFilter:="xls Files (*.xls), *.xls") ' диалог для ввода имени таблицы
    End With
    
Dim newSheet As Worksheet
Set newSheet = NewBook.Sheets(1)
Dim LastRow_inA As Long ' определяем количество строк в исходном файле
With iSheet
        LastRow_inA = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
Dim num_col  As Long
Dim i As Long
newSheet.Cells(2, "A") = iSheet.Cells(1, "A") 
newSheet.Cells(1, "A") = "Название" ' в первой строке будет "шапка"
Dim counter As Long
counter = 2
Dim found As Boolean
    For i = 2 To LastRow_inA ' поехали просматривать строку за строкой
       If iSheet.Cells(i, "A").Value = Empty Then ' пустая строка означает, что сейчас будет новый пункт
                counter = counter + 1
                i = i + 1
                newSheet.Cells(counter, "A") = iSheet.Cells(i, "A")
       Else
            cell_splited = Split(iSheet.Cells(i, 1).Value, ":")         
            For intIndex = LBound(cell_splited) To UBound(cell_splited)
                 found = False ' если такого поля не было, то добавим его в шапку, а если есть, то просто запишем значение в нужную колонку
                 num_col = newSheet.UsedRange.Columns.Count
            
                For j = 1 To newSheet.UsedRange.Columns.Count
                        If cell_splited(0) = newSheet.Cells(1, j).Value Then
                            found = True
                            newSheet.Cells(counter, j).Value = cell_splited(1)
                        
                        End If
                Next j
                If found = False Then
             
                        newSheet.Cells(1, num_col + 1).Value = cell_splited(0)
                        newSheet.Cells(counter, num_col + 1).Value = cell_splited(1)
                End If
         Next intIndex

    End If
Next i
End Sub

Макрос имеет ограничение на количество строк в txt-файле(65536): его накладывает сам Excel. Если выборки делать всегда небольшие, то можно Long заменить на менее дорогой тип.

Реклама

Entry filed under: Uncategorized. Tags: , , , .

Sudo, я сказала Sudo! Сброс сессий терминалов в XP.

Добавить комментарий

Заполните поля или щелкните по значку, чтобы оставить свой комментарий:

Логотип WordPress.com

Для комментария используется ваша учётная запись WordPress.com. Выход / Изменить )

Фотография Twitter

Для комментария используется ваша учётная запись Twitter. Выход / Изменить )

Фотография Facebook

Для комментария используется ваша учётная запись Facebook. Выход / Изменить )

Google+ photo

Для комментария используется ваша учётная запись Google+. Выход / Изменить )

Connecting to %s

Trackback this post  |  Subscribe to the comments via RSS Feed



%d такие блоггеры, как: