Подбор минус-слов в Яндекс Директ с помощью макроса Microsoft Excel

В начале сентября Яндекс порадовал нас новым отчетом по поисковым запросам, который теперь показывает не только запросы, по которым были клики, а и те, по которым мы получили показы. Это дает нам потенциальную возможность избавиться от лишних показов и, как следствие, поднять CTR, а также сократить количество нежелательных кликов в будущем.

В этой статье мы поделимся нашим скриптом для Microsoft Excel, который позволяет вычленять из поисковых запросов будущие минус-слова быстро и эффективно, а также значительно сократить время на работу с отчетом, т.к. мы не будем тратить время на просмотр запросов, которые уже одобрены в виде фраз.

Этап №1. Сохранение отчета по поисковым запросам

В данной статье, для простоты, мы будем показывать работу на примере одной РК.

Итак, первое, что мы делаем — выбираем нужную РК и переходим в раздел статистики.

Выбираем вкладку «Поисковые запросы». При желании можно сразу отфильтровать по количеству конверсий, чтобы исключить из отчета те запросы, что дали нам конверсии – их минусовать смысла нет. Нажимаем Экспорт в xlsx, т.к. работать дальше будем в Microsoft Excel.

Этап №2. Выгрузка ключевых фраз из соответствующей РК

Суть работы скрипта – оставить из всех запросов только те слова, что мы предварительно не одобрили как «плюс-слова». То есть те, что встречаются в наших ключевых словах (логично, что если они есть в ключевых словах, значит, мы дали добро на их открутку), любые другие списки, которые мы не хотим минусовать — например, бренды, города и т.п.

Делаем выгрузку фраз. Можно это сделать как с помощью веб-интерфейса:

Так и через Директ Коммандер

Этап №3. Сводим все вместе

Итоговый файл должен иметь примерно такую структуру:

Ключевая фраза | Поисковый запрос | Показатели

За базовый берем отчет по поисковым запросам, в который просто переносим столбец с ключами. Это, собственно, единственная необходимая манипуляция на этом этапе. Также чисто из эстетических соображений удаляем ненужные строки и столбцы.

Итоговая таблица примет приблизительно такой вид:

Этап №4. Установка и запуск макроса

Для запуска открываем редактор Visual Basic. Делается это или через интерфейс Excel:

Если у вас этой вкладки нет, ее нужно добавить. Для этого заходим в настройки (в английском Excel: File > Options > Customize Ribbon > Main Tabs > ставим галочку на Developer).

Или же просто используем сочетание клавиш ALT + F11.

В открывшемся редакторе создаем модуль:

В который вставляем текст скрипта:

disclaimer: Скрипты написаны не профи-программистом: пожелания, замечания и изменения кода приветствуются

Sub SearchTerms()
'Updateby20160628 by UAWC. Ivan Gurin
Dim x
Dim arr() As String
Dim xValue As String
Dim aValue As String
Dim Splitted() As String
Dim InputRng As Range, OutRng As Range, Keywords As Range
xTitleId = "UAWC Agency SearchTerms Analyzer Yandex"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("SearchTerms + Impressions + Clicks + Cost :", xTitleId, InputRng.Address, Type:=8)
Set Keywords = Application.Selection
Set Keywords = Application.InputBox("Keywords :", xTitleId, Keywords.Address, Type:=8)
Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)
Set dicKeywords = CreateObject("Scripting.Dictionary")
dicKeywords.CompareMode = vbTextCompare 'case insensitive
Set dicFinal = CreateObject("Scripting.Dictionary")
dicFinal.CompareMode = vbTextCompare 'case insensitive

With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
End With

For j = 1 To Keywords.Columns.Count
    For i = 2 To Keywords.Rows.Count
        xValue = Keywords.Cells(i, j).Value
        Dim indexOfDash As Integer
        indexOfDash = InStr(1, xValue, "-")
        If indexOfDash > 0 Then
        Dim newxValue As String
        newxValue = Left(xValue, indexOfDash - 2)
        Else: newxValue = xValue
        End If
        For Each x In Split(RuOnly(newxValue), " ")
        If x <> "" And Not dicKeywords.Exists(x) Then
            dicKeywords(x) = ""
        End If
        Next
    Next
Next


For i = 2 To InputRng.Rows.Count
        aValue = InputRng.Cells(i, 1).Value
        For Each x In Split(RuOnly(aValue), " ")
        If x <> "" And Not dicKeywords.Exists(x) Then
        If dicFinal.Exists(x) Then
        Set dic2 = dicFinal.Item(x)
            dic2.Item("Impressions") = dic2.Item("Impressions") + InputRng.Cells(i, 2).Value
            dic2.Item("Clicks") = dic2.Item("Clicks") + InputRng.Cells(i, 3).Value
            dic2.Item("Cost") = dic2.Item("Cost") + InputRng.Cells(i, 4).Value
        Else
            Set dic2 = CreateObject("Scripting.Dictionary")
            dic2.CompareMode = vbTextCompare
            dic2.Add "Impressions", InputRng.Cells(i, 2).Value
            dic2.Add "Clicks", InputRng.Cells(i, 3).Value
            dic2.Add "Cost", InputRng.Cells(i, 4).Value
            dicFinal.Add x, dic2
        End If
        End If
        Next
Next

Set OutRng = OutRng.Offset(0, 1)
OutRng.Value = "Impressions"
Set OutRng = OutRng.Offset(0, 1)
OutRng.Value = "Clicks"
Set OutRng = OutRng.Offset(0, 1)
OutRng.Value = "Cost"
Set OutRng = OutRng.Offset(1, -3)

For Each Key In dicFinal
    OutRng.Value = Key
    Set OutRng = OutRng.Offset(0, 1)
    For Each kk In dicFinal(Key).keys
    OutRng.Value = dicFinal(Key).Item(kk)
    Set OutRng = OutRng.Offset(0, 1)
    Next
    Set OutRng = OutRng.Offset(1, -4)
Next


With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
End With


MsgBox "Naslajdaytes'"

End Sub

Function RuOnly(strSource As String) As String
    Dim i As Integer
    Dim strResult As String

    For i = 1 To Len(strSource)
        Select Case Asc(Mid(strSource, i, 1))
            Case 32, 48 To 57, 60 To 90, 97 To 122, 128 To 255:  '32 - probel, 48 to 57 - cyfry, 60 to 90, 97 to 122- english Letters, 128 to 255 - russian
                strResult = strResult & Mid(strSource, i, 1)
        End Select
    Next
    RuOnly = strResult
End Function

100

101

102

103

104

105

Sub SearchTerms()

'Updateby20160628 by UAWC. Ivan Gurin

Dim x

Dim arr() As String

Dim xValue As String

Dim aValue As String

Dim Splitted() As String

Dim InputRng As Range, OutRng As Range, Keywords As Range

xTitleId = "UAWC Agency SearchTerms Analyzer Yandex"

Set InputRng = Application.Selection

Set InputRng = Application.InputBox("SearchTerms + Impressions + Clicks + Cost :", xTitleId, InputRng.Address, Type:=8)

Set Keywords = Application.Selection

Set Keywords = Application.InputBox("Keywords :", xTitleId, Keywords.Address, Type:=8)

Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)

Set dicKeywords = CreateObject("Scripting.Dictionary")

dicKeywords.CompareMode = vbTextCompare 'case insensitive

Set dicFinal = CreateObject("Scripting.Dictionary")

dicFinal.CompareMode = vbTextCompare 'case insensitive

With Application

.ScreenUpdating = False

.Calculation = xlCalculationManual

End With

For j = 1 To Keywords.Columns.Count

For i = 2 To Keywords.Rows.Count

xValue = Keywords.Cells(i, j).Value

Dim indexOfDash As Integer

indexOfDash = InStr(1, xValue, "-")

If indexOfDash > 0 Then

Dim newxValue As String

newxValue = Left(xValue, indexOfDash - 2)

Else: newxValue = xValue

End If

For Each x In Split(RuOnly(newxValue), " ")

If x <> "" And Not dicKeywords.Exists(x) Then

dicKeywords(x) = ""

End If

For i = 2 To InputRng.Rows.Count

aValue = InputRng.Cells(i, 1).Value

For Each x In Split(RuOnly(aValue), " ")

If x <> "" And Not dicKeywords.Exists(x) Then

If dicFinal.Exists(x) Then

Set dic2 = dicFinal.Item(x)

dic2.Item("Impressions") = dic2.Item("Impressions") + InputRng.Cells(i, 2).Value

dic2.Item("Clicks") = dic2.Item("Clicks") + InputRng.Cells(i, 3).Value

dic2.Item("Cost") = dic2.Item("Cost") + InputRng.Cells(i, 4).Value

Else

Set dic2 = CreateObject("Scripting.Dictionary")

dic2.CompareMode = vbTextCompare

dic2.Add "Impressions", InputRng.Cells(i, 2).Value

dic2.Add "Clicks", InputRng.Cells(i, 3).Value

dic2.Add "Cost", InputRng.Cells(i, 4).Value

dicFinal.Add x, dic2

End If