Познакомимся с макросом для расстановки подписей для линейного графика в Excel, который поможет избежать наложения подписей данных друг на друга.
Приветствую всех, дорогие читатели блога TutorExcel.Ru.
Редкие графики в Excel обходятся без отображения чисел в качестве подписи данных, и изредка при добавлении подписи на любую диаграмму могут возникать ситуации, когда числа начинают наползать друг на друга.
Из-за этого данные становится трудно читать и вместо нескольких отдельно стоящих чисел мы видим мешанину цифр.
В результате все это приводит к тому, что информативность графика снижается, так как цифры попросту плохо видно.
Вероятно, наиболее остро эта проблема стоит при работе с линиями на диаграммах (которые могут пересекаться, что зачастую и приводит к подобной проблеме):
Так каким образом мы можем избавиться от наложения при расстановке чисел?
Для линейного графика в Excel в настройке формата подписи можно выбрать один из 5 вариантов положения (либо для всех точек ряда данных, либо по отдельности для каждой): в центре, слева, справа, сверху или снизу.
При этом наиболее часто используются два последних варианта (сверху и снизу).
Первое, что приходит в голову как один из вариантов решения — ручное проставление подписей для проблемных точек.
Соответственно, для каждой такой точки в настройках формата данных будет необходимо вручную задать одно из положений.
Все хорошо, если таких точек мало. К сожалению, все становится куда сложнее, когда таких точек и графиков много и на ручную обработку тратится уже не несколько секунд.
Поэтому, вместо ручного труда и потери времени, рассмотрим другой способ.
Автоматизируем данный процесс и напишем макрос, который будет за нас автоматически расставлять подписи.
Алгоритм расстановки подписей на графике
В зависимости от количества рассматриваемых точек проанализируем самые частые случаи:
- 2 точки; Возьмем пару точек, по одной из каждого графика и сравним их значения. Для той точки, значение которой больше (выбираем ту, которая находится выше) ставим подпись сверху, соответственно, для второй точки (значение которой меньше) — снизу.
- 3 точки; Для самой верхней и самой низкой точек расставляем подписи аналогично примеру выше. Для средней же точки подпись поместим туда где осталось больше места (т.е. если значение средней точки ближе к верхней, то ставим снизу, и наоборот, если значение средней точки ближе к нижней, то ставим сверху).
- 4 и более точек. В случае большого количества подписей на диаграмме избежать наложения будет достаточно сложно, к тому же, обычно на график добавляют лишь несколько рядов с подписями, поэтому отдельно данный случай разбирать не будем.
Таким образом, следуя заданным правилам, мы с большой вероятностью избежим наложения чисел друг на друга. Теперь сведем все части вместе и преобразуем данный алгоритм в код VBA.
Макрос расстановки подписей
Для добавления макроса переходим в редактор Visual Basic (горячая клавиша Alt + F11), создаём новый модуль и вставляем туда код (как и обычно, напротив основных действий макроса даются пояснения к коду):
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 |
Sub PutLabels() Application.ScreenUpdating = False Dim PointValues(3) As Variant 'массив для хранения значений точек Dim IndexValues(3) As Variant 'массив для хранения номеров рядов Dim LabelsCount As Integer LabelsCount = 0 For i = 1 To ActiveChart.SeriesCollection.Count 'цикл по всем рядам графика If ActiveChart.SeriesCollection(i).HasDataLabels = True And LabelsCount < 3 Then 'Проверка условия, что у ряда есть подпись данных PointValues(LabelsCount) = ActiveChart.SeriesCollection(i).Values 'Записываем в массив значения точек IndexValues(LabelsCount) = i 'Записываем в массив номер ряда LabelsCount = LabelsCount + 1 End If Next i For j = LBound(PointValues(0)) To UBound(PointValues(0)) 'Цикл по всем точкам ряда If LabelsCount = 2 Then 'Если количество рядов с подписями равно 2 If PointValues(0)(j) > PointValues(1)(j) Then ActiveChart.SeriesCollection(IndexValues(0)).Points(j).DataLabel.Position = xlLabelPositionAbove ActiveChart.SeriesCollection(IndexValues(1)).Points(j).DataLabel.Position = xlLabelPositionBelow Else ActiveChart.SeriesCollection(IndexValues(0)).Points(j).DataLabel.Position = xlLabelPositionBelow ActiveChart.SeriesCollection(IndexValues(1)).Points(j).DataLabel.Position = xlLabelPositionAbove End If ElseIf LabelsCount = 3 Then '... равно 3 If (PointValues(0)(j) > PointValues(1)(j) And PointValues(0)(j) > PointValues(2)(j)) Or (PointValues(0)(j) > PointValues(1)(j) And PointValues(0)(j) < (PointValues(1)(j) + PointValues(2)(j)) / 2) Or (PointValues(0)(j) > PointValues(2)(j) And PointValues(0)(j) < (PointValues(1)(j) + PointValues(2)(j)) / 2) Then ActiveChart.SeriesCollection(IndexValues(0)).Points(j).DataLabel.Position = xlLabelPositionAbove Else: ActiveChart.SeriesCollection(IndexValues(0)).Points(j).DataLabel.Position = xlLabelPositionBelow End If If (PointValues(1)(j) > PointValues(0)(j) And PointValues(1)(j) > PointValues(2)(j)) Or (PointValues(1)(j) > PointValues(0)(j) And PointValues(1)(j) < (PointValues(0)(j) + PointValues(2)(j)) / 2) Or (PointValues(1)(j) > PointValues(2)(j) And PointValues(1)(j) < (PointValues(0)(j) + PointValues(2)(j)) / 2) Then ActiveChart.SeriesCollection(IndexValues(1)).Points(j).DataLabel.Position = xlLabelPositionAbove Else: ActiveChart.SeriesCollection(IndexValues(1)).Points(j).DataLabel.Position = xlLabelPositionBelow End If If (PointValues(2)(j) > PointValues(0)(j) And PointValues(2)(j) > PointValues(1)(j)) Or (PointValues(2)(j) > PointValues(0)(j) And PointValues(2)(j) < (PointValues(0)(j) + PointValues(1)(j)) / 2) Or (PointValues(2)(j) > PointValues(1)(j) And PointValues(2)(j) < (PointValues(0)(j) + PointValues(1)(j)) / 2) Then ActiveChart.SeriesCollection(IndexValues(2)).Points(j).DataLabel.Position = xlLabelPositionAbove Else: ActiveChart.SeriesCollection(IndexValues(2)).Points(j).DataLabel.Position = xlLabelPositionBelow End If End If Next j Application.ScreenUpdating = True End Sub |
Идем дальше. Применим написанный макрос к графику (на примере графика из начала статьи).
Из редактора Visual Basic возвращаемся в Excel. Выделяем график, в котором мы хотим поменять положение подписей (так как макрос обрабатывает активный график), и запускаем макрос.
В результате получаем:
Теперь добавим подпись данным к любому из рядов с данными и посмотрим на результат работы макроса уже для 3 рядов:
Пример работы макроса (для случая с 3 линиями):
В данном примере мы реализовали алгоритм для одного конкретного выделенного графика.
В случае необходимости, если графиков много и они находятся на нескольких листах, то код макроса можно подправить (либо создать новые) и сделать так, чтобы подписи расставлялись для всех графиков листа или всей книги — все зависит от конкретной задачи:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 |
Sub PutLabelsForSheet() 'Для активного листа For i = 1 To ActiveSheet.ChartObjects.Count ActiveSheet.ChartObjects(i).Activate Call PutLabels Next i End Sub Sub PutLabelsForWorkbook() 'Для всех листов книги For i = 1 To ActiveWorkbook.Sheets.Count ActiveWorkbook.Sheets(i).Activate Call PutLabelsForSheet Next i End Sub |
Спасибо за внимание!
Если у вас остались вопросы — пишите в комментариях.
Удачи вам и до скорых встреч на страницах блога TutorExcel.Ru!