用于创建多个图表的宏,这些宏未显示基于数组的轴的正确值

时间:2018-12-01 08:06:39

标签: excel vba

我对在VBA中创建宏非常陌生,并尝试编写一个宏以制作多个图表。在研究和花费了一天的大部分时间之后,我将到目前为止所拥有的东西汇总在一起,该宏将在“ For”循环中生成指定图表的数量,但是轴不正确。 x轴应该是在我用来创建'duplicatesArr'数组作为边界的起始范围内的最低值和最高值,而y轴则是要用来计算来自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

我确定我的经验不足的眼睛确实遗漏了一些明显的错误,但是对我来说,发现它们/研究它们可能要花费很多时间,我希望我能在此找到一些指导。 Here是从运行宏获取的图表的链接。尽管我试图将它们剪切并粘贴到下一张纸上,但它们最初是彼此堆叠的,这是另一个不那么重要的问题。我需要帮助的主要事情是理解为什么轴未正确旋转。我将不胜感激任何建议!

编辑:Here是我正在使用的数据的示例。在不使用宏的情况下,我必须从列中创建数据透视图以创建图形,但是在宏中,它需要从水平范围获取数据。 Here是图表的示例,但我希望实际的图表具有最小值。 48和最大该数据集的63个数据,并且像日期轴一样分布。

0 个答案:

没有答案