Макрос для создания нескольких диаграмм, не показывающий правильных значений для осей на основе массивов - PullRequest
0 голосов
/ 01 декабря 2018

Я очень новичок в создании макросов в VBA и попытался написать один для создания нескольких диаграмм.Изучив и потратив большую часть дня, собирая то, что у меня есть, макрос создаст количество указанных диаграмм в цикле «For», но оси не верны.Предполагается, что ось x имеет наименьшее и наибольшее числа в начальном диапазоне, который я использую для создания массива duplicatesArr в качестве границ, а ось y предназначена для подсчета каждого дублирующегося значения в duplicatesArr в диапазоне от 0 до (количество ячеек вуказанный диапазон / 2)

Sub CreateClusteredColumn()

Dim startCell As Range
Dim cellCount As Integer
Dim counter As Integer
Dim cht As Object
Dim uniqArt As Variant
Dim duplicatesArr As Variant
Dim xAxis As Series
Dim yAxis As Series


For counter = 1 To 3

    Set cht = ActiveSheet.Shapes.AddChart2
    cht.Chart.ChartType = xlColumnClustered

    Set startCell = ActiveSheet.Range("F1").Offset(counter - 1, 0)
    Range(startCell, startCell.End(xlToRight)).Select
    cellCount = Selection.Cells.Count

    If cellCount < 30 Then 'not enough data to make a chart
        GoTo endLoop
        End If

    Dim perIssue() As Variant
    ReDim perIssue(0 To cellCount / 2)

    ySlice = Application.Transpose(Application.Index(perIssue, 0, 0))

    Set yAxis = cht.SeriesCollection(1)
    yAxis.Values = ySlice

    duplicatesArr = Application.Transpose(Application.Transpose(Range(startCell, startCell.End(xlToRight))))
    uniqArt = RemoveDupes(duplicatesArr)

    Set xAxis = cht.SeriesCollection(1)
    xAxis.XValues = uniqArt

    ActiveSheet.ChartObjects(1).Activate

    ActiveSheet.ChartObjects(1).Cut

    Sheets("GroupCharts").Select

    ActiveSheet.Paste

    Sheets("ArticleGroups").Select

endLoop:
Next counter

End Sub

Function RemoveDupes(InputArray) As Variant
    Dim dic As Object
    Dim Key As Variant
    Set dic = CreateObject("Scripting.Dictionary")
    For Each Key In InputArray
        dic(Key) = 0
    Next
    RemoveDupes = dic.keys
End Function

Я уверен, что есть некоторые очевидные ошибки, которые пропустил мой неопытный глаз, но для меня, чтобы обнаружить их / исследование о них, может потребоваться много часов, и я надеялся, что смогуполучить какое-то направление здесь, чтобы помочь. Здесь - это ссылка на графики, которые я получаю от запуска макроса.Первоначально они были сложены друг на друга, хотя я пытаюсь вырезать их и наклеить на следующем листе, что является еще одним менее важным вопросом.Главное, в чем я нуждаюсь, это понимание того, почему оси не поворачиваются правильно.Буду очень признателен за любые советы!

Редактировать: Здесь - это пример данных, которые я использую.Без использования макроса мне нужно сделать сводную диаграмму из столбца, чтобы построить график, но в макросе он берет данные из горизонтального диапазона. Здесь - это пример графика, но я бы хотел, чтобы на фактическом графике был Мин.48 и Макс.63 для этого набора данных и будет распространяться как ось даты.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...