如何从范围内的唯一值创建图表

问题描述

我有通过用户表单填充到工作表上的项目。当我打开工作簿时，我试图让工具转到工作表，抓取数据并在主着陆页上生成图表/仪表板。

在数据范围内包含状态。我希望 VBA 查看一列数据并创建一个图表来计算每个不同的状态并将其放入条形图中。

yaxis = 不同的状态
xaxis = 计数

到目前为止我的代码

Sub populatecharts()
    Dim ws As Worksheet
    Dim ch As Chart
    Dim tablerng As Range
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim sh As String

    Set ws = ActiveSheet

    'When the workbook opens it should always check the data and populate the BA Dashboard
    'I need to check for sheets and if they exist generate a chart from the data

    sh = "Action"
    On Error Resume Next

    Worksheets("Action").Visible = True

    If CheckSheetExist(sh) = False Then
        GoTo nextchart1
    Else
        Worksheets(sh).Activate
        'Set ws = ActiveSheet
        Set rng1 = Range("G4",Range("G4","G4").End(xlDown))
        rng1.Select
        'Set rng2 = Range("B2")
        'Set rng3 = Range("C3")
        'Set tablerng = rng1 '& rng2 & rng3
        Set ch = ws.Shapes.AddChart2(Width:=200,Height:=200,Left:=Range("B4").Left,Top:=Range("B4").Top).chart

        With ch
            .SetSourceData Source:=rng1
            .ChartType = xlBarClustered
            .ChartTitle.Text = "Action Items by Status"
        End With

        ws.Activate
        Worksheets("Action").Visible = False
    End If

看起来很简单，但我想不通，即使我定义了顶部和底部以及大小，位置也会被击中或错过。有时它在我选择左边的单元格的右边。

解决方法

请尝试下一个方法。它使用字典来提取唯一值及其计数和数组以提供必要的系列。尝试在活动工作表上运行它，并在确认返回的内容是您需要的内容后根据您的情况进行调整：

Sub populatecharts()
  Dim shT As Worksheet,ch As Chart,lastRow As Long
  Dim arrY,arrX,i As Long,dict As Object
  
  Set shT = ActiveSheet 'use here the sheet you need
  lastRow = shT.Range("G" & shT.Rows.count).End(xlUp).row
  arrX = shT.Range("G4:G" & lastRow).Value        'put the range in a array
  Set dict = CreateObject("Scripting.Dictionary") 'needed for the next step
  
  On Error Resume Next
   shT.ChartObjects("MyChartXY").Delete   'for the case of re running need
  On Error GoTo 0

  For i = 1 To UBound(arrX)
    If Not dict.Exists(arrX(i,1)) Then
        dict(arrX(i,1)) = 1                    'create the unique keys
    Else
        dict(arrX(i,1)) = dict(arrX(i,1)) + 1 'increment the key next occurrrence
    End If
  Next i
  arrX = dict.Keys: arrY = dict.Items           'extract the necessary arrays
  
  Set ch = shT.ChartObjects.Add(left:=shT.Range("B4").left,_
            top:=shT.Range("B4").top,width:=200,height:=200).Chart
  With ch
    .ChartType = xlBarClustered
    .HasTitle = True
    .ChartTitle.Text = "Action Items by Status"
    .SeriesCollection.NewSeries.Values = arrY   'feed it with the array elements
    .SeriesCollection(1).XValues = arrX         'feed it with the array elements
  End With
End Sub

请测试并发送一些反馈。