Упрощение жизни с кластерами запросов
- Настройка при работе первый раз с макросами
- Макрос выделения основного запроса кластера
- Макрос выделения кластеров после маркерной привязки, и их нумерации
Настройка при работе первый раз с макросами
При первом запуске макросов на ПК необходимо выполнить до настройки MS Excel
3. Заходим в центр управления безопасностью
4. Выставляем настройки, как на рисунке ниже
5. В случае отсутствия в меню пункта разработчик - его нужно добавить в ленту. Нам необходим этот элемент чтобы видеть VBA код
Дальше можно начать работать с файлом с кластерами. Открываем файл и переходим во вкладку Разработчик и нажимаем Visual Basic
Я располагаю окна следующим образом - окно с кластерами Кнопка Win + Стрелочка влево, Код Макроса Кнопка Win + Стрелочка вправо
6. Нажимаем в области таблиц ПКМ добавить модуль
7. Копируем код макроса и вставляем в модуль
8. Обязательно выделяем ячейку в нашем файле с кластерами. А то если много Excel файлов открыто - может отработать на другом активном
Макрос выделения основного запроса кластера
Макрос позволяет в работе выделять основной запрос кластера при черновой кластеризации. Он анализирует файлы по силе группировки 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
.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
a = 1
i = 2
Do While i <= lastRow
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
Else
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
Результат после использования скрипта
В дополнение макрос рассчитывает силу кластера по частотности по порядку.
Нет предела совершенству и в дальнейшем планирую проработать макросы и добавить горячие клавиши, опять же для удобства работы.