Упрощение жизни с кластерами запросов

Настройка при работе первый раз с макросами

При первом запуске макросов на ПК необходимо выполнить до настройки MS Excel

1. Зайти в пункт меню файл

2. Далее – параметры

3. Заходим в центр управления безопасностью

4. Выставляем настройки, как на рисунке ниже

5. В случае отсутствия в меню пункта разработчик - его нужно добавить в ленту. Нам необходим этот элемент чтобы видеть VBA код

Дальше можно начать работать с файлом с кластерами. Открываем файл и переходим во вкладку Разработчик и нажимаем Visual Basic

Я располагаю окна следующим образом - окно с кластерами Кнопка Win + Стрелочка влево, Код Макроса Кнопка Win + Стрелочка вправо

6. Нажимаем в области таблиц ПКМ добавить модуль

7. Копируем с Яндекс диска код макроса и вставляем в модуль

8. Обязательно выделяем ячейку в нашем файле с кластерами. А то если много Excel файлов открыто - может отработать на другом активном

9. Далее запускаем макрос

Макрос выделения основного запроса кластера

Макрос позволяет в работе выделять основной запрос кластера при черновой кластеризации. Он анализирует файлы по силе группировки 3 и 4 и помогает не пропускать переход к новым значениям.

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

А вот и сам макрос

Dim lastRow, i, y As Long
Sub first()
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
' Указать начальную строку 1 1
i = 25279
Do While i <= lastRow
y = i
Do While (Cells(i, 2) = Cells(y, 2)) And Cells(i, 3) = Cells(y, 3) And (Cells(i, 2) <> 0)
Cells(i, 1).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535</p><p>.TintAndShade = 0
.PatternTintAndShade = 0
End With
y = y + 1
Loop
i = y
If Cells(i, 1).Interior.Color = 65535 Then
i = i + 1
End If
Loop
End Sub

Макрос выделения кластеров после маркерной привязки, и их нумерации

Для упрощения работы было принято решение написать скрипт по автоматизации процесса выделения кластеров после маркерной привязки и их нумерации.

После того как осуществлена необходимая сортировка можно выполнить скрипт.

Скрипт:

Dim lastRow, i, y, a, line As Long
Sub first()
Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
lastRow = Cells(Rows.Count, 2).End(xlUp).Row
' Начальные значения переменных i = строка после шапки
line = 0</p><p>a = 1</p><p>i = 2
Do While i <= lastRow</p><p>y = i
'Здесь задаем столбик для вычисления веса кластера. По умолчанию 8 столбик
'Плюс необходимо задать столбик с частотностью попорядку
Cells(i, 8) = Cells(i, 7)
Do While Cells(i, 2) = Cells(y, 2)
If line = 0 Then
Cells(i, 1).Value = a
Rows(i).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
line = 1</p><p>Else</p><p>Cells(y, 1).Value = a
Cells(i, 8) = Cells(i, 8) + Cells(y, 7)
End If
y = y + 1
Loop
a = a + 1
line = 0
i = y
If Cells(i, 1).Interior.Color = 65535 Then
i = i + 1
End If
Loop
End Sub

Результат после использования скрипта

В дополнение макрос рассчитывает силу кластера по частотности по порядку.

Нет предела совершенству и в дальнейшем планирую проработать макросы и добавить горячие клавиши, опять же для удобства работы.