Объединяем все XML файлы в один файл, готовим «ключи» правильно

Автор: | 05.03.2016

Итак, вот мы с вами распарсили Google Adwords или семраш и имеем большое колво xml файлов. Задача стоит объединить все их в один файл наиболее просто и быстро.

Нам потребуется, открыть Excel, создаем новую страницу.

Далее нажимаем ALT + F11. У нас открывается Microsoft Visual Basic! Далее идем в Insert — Module

Копируем туда:

Sub FiziK()
Const strStartDir = "c:\test" 'папка, с которой начать обзор файлов
Const strSaveDir = "c:\test\result" 'папка, в которую будет предложено сохранить результат
Const blInsertNames = True 'вставлять строку заголовка (книга, лист) перед содержимым листа
Dim wbTarget As New Workbook, wbSrc As Workbook, shSrc As Worksheet, shTarget As Worksheet, arFiles, _ i As Integer, stbar As Boolean, clTarget As Range
On Error Resume Next 'если указанный путь не существует, обзор начнется с пути по умолчанию
ChDir strStartDir
On Error GoTo 0
With Application 'меньше писанины
arFiles = .GetOpenFilename("Excel Files (*.xls), *.xls", , "Объединить файлы", , True)
If Not IsArray(arFiles) Then End 'если не выбрано ни одного файла
Set wbTarget = Workbooks.Add(template:=xlWorksheet)
Set shTarget = wbTarget.Sheets(1) .ScreenUpdating = False stbar = .DisplayStatusBar .DisplayStatusBar = True
For i = 1 To UBound(arFiles) .StatusBar = "Обработка файла " & i & " из " & UBound(arFiles) Set wbSrc = Workbooks.Open(arFiles(i), ReadOnly:=True) For Each shSrc In wbSrc.Worksheets If IsNull(shSrc.UsedRange.Text) Then 'лист не пустой Set clTarget = shTarget.Range("A1").Offset(shTarget.Range("A1").SpecialCells(xlCellTypeLastCell).Row, 0) If blInsertNames Then clTarget = ">>> " & wbSrc.Name & " -- " & shSrc.Name Set clTarget = clTarget.Offset(1, 0) End If shSrc.UsedRange.Copy clTarget End If Next wbSrc.Close False 'закрыть без запроса на сохранение
Next .ScreenUpdating = True .DisplayStatusBar = stbar .StatusBar = False
On Error Resume Next 'если указанный путь не существует и его не удается создать, 'обзор начнется с последней использованной папки
If Dir(strSaveDir, vbDirectory) = Empty Then MkDir strSaveDir
ChDir strSaveDir
On Error GoTo 0
arFiles = .GetSaveAsFilename("Результат", "Excel Files (*.xls), *.xls", , "Сохранить объединенную книгу")
If VarType(arFiles) = vbBoolean Then 'если не выбрано имя GoTo save_err
Else On Error GoTo save_err wbTarget.SaveAs arFiles
End If
End
save_err: MsgBox "Книга не сохранена!", vbCritical
End With
End Sub

Жмем Close and Return

Попадаем обратно в Excel.

Теперь нажимаем Alt + F8. У нас должен появиться недавно добавленный макрос. Если вы видите это, значит все ОК.

Нажимаем выполнить. Нам предложит выбрать файлы. Идем в нашу папку, с помощью Shift выделяем все и нажимаем открыть. Программа обработает все файлы и выведет на одну страницу, предложит сохранить. Сохраняем и видим, что добавленно много всего ненужного.

Не пугаемся! Выделяем все, жмем отсортировать от А до Я

Весь ненужный мусор оказался теперь вверху. Выделяем точно так же с помощью Shift и удаляем ячейки со сдвигом вверх.

И получаем чистую базу кейвордов. Далее не мешало бы ее чекнуть на дубли. Открываем KeyWordKeeper или Пингвин и удаляем «Дубли». Получается чистая база. Так же с помощью замены можно удалить кавычки (» ‘) т.к. не все доргены их поддерживают. Просим у ПП информационные и стоп слова. Минусуете к примеру с помощью KeyKollector. И работаете по базе.

Всем спасибо за внимание! Новость не сильно гениальная и революционная, но может помочь сэкономить кучу времени новичкам. И не придется лазить по форумам в поисках нужных макросов. :) Спасибо Физику за рабочий макрос.

Объединяем все XML файлы в один файл, готовим «ключи» правильно: 2 комментария

  1. IsmaelDep

    Господи, шо за фигня?) Все делается в 3 клика в text pipe pro на автомате. Эксели какие-то, ебануться.

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

Ваш e-mail не будет опубликован. Обязательные поля помечены *