根据另一张纸上的动态自动过滤器在一张纸上创建图表-返回错误的范围

时间:2019-06-05 09:15:02

标签: excel vba

我有一本包含多张纸的excel工作簿。第一张工作表是一个仪表板,我在该仪表板上基于其他工作表的数据显示图表。 我有一个名为每日分数的表。其中有三列: 用户ID,总和点收藏夹,日期时间戳 在任何给定的一天,用户都可以插入一行,其中包含他们添加的点和添加的日期。 标题行从A3开始,并已应用自动过滤器。

在仪表板上,我创建了一个按钮,要求用户通过输入框插入UserID。基于该数据,我过滤数据以仅显示该用户的分数。 示例结果将是:

User ID Sum_PointsAdded Day_Timestamp
777      38                28/3/19
777      11                20/3/19
777      44                2/4/19
777      24                13/5/19

我添加的图表是折线图,应该仅显示一条线(图例中为一种输入类型)。 X轴是日期,Y轴是分数。

如果我手动使用“每日得分”表上的过滤器,然后单击“仪表板”表上的按钮并请求过滤器,则图表显示为“确定”。但是,如果我只是单击仪表板上的图表按钮,并且不使用过滤器,那么我得到的图表将有一行Sum_Point Transactions和一行Day_Timestamp(我不应该得到),也没有分数线。 图例有四个条目:分数,总和积分,日时间戳和系列4

我假设我在过滤器或图表范围的定义方面做错了。但是,我在仪表板工作表上确实有另一个图表,其设置完全相同(图表上只有两条线),而且没有问题。 我尝试过更改范围定义的位置,但似乎不起作用。 注意:这些是动态范围。 这是我的代码:

Public Sub CreateDailyScoreChart()

Dim WS As Worksheet
Dim WS2 As Worksheet
Dim Rng1 As Range
Dim Rng2 As Range
Dim myValue As Variant
Dim LastRow As Long
Dim FirstRow As Long
Application.ScreenUpdating = False

Set WS = ThisWorkbook.Sheets("Daily Score")
Set WS2 = ThisWorkbook.Sheets("Dashboard")

With WS
'set last row for entire table in order to define range
 LastRow = .Range("A" & Rows.Count).End(xlUp).Row
 Set Rng1 = .Range("A3:A" & LastRow)
 Set Rng2 = .Range("C3:C" & LastRow)
End With


'Input UserID
myValue = InputBox("Insert UserID")

'Filter based on UserID, for this month decending
Sheets("Daily Score").Activate
    On Error Resume Next
    ActiveSheet.ShowAllData
    Rng1.CurrentRegion.AutoFilter Field:=1, Criteria1:="=" & myValue


  On Error GoTo 0
With WS.AutoFilter.Sort
.SortFields.Clear
.SortFields.Add2 Key _
        :=Rng2, SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Rng2.AutoFilter Field:=3, Criteria1:=13, _
        Operator:=11, Criteria2:=0, SubField:=0

With WS
 FirstRow = .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Row
'reset last row for filtered table
 LastRow = .Range("A" & Rows.Count).End(xlUp).Row
End With

'Delete existing chart if it exists
On Error Resume Next
With WS2
.ChartObjects("DailyScore").Activate
.ChartObjects("DailyScore").Delete
End With
On Error GoTo 0

'Add new chart
'ThisWorkbook.Sheets("Dashboard").Shapes.AddChart2(322, xlLineMarkers).Select
WS.Activate
WS.Shapes.AddChart2(332, xlLineMarkers).Select


Dim Chart As Chart
Set Chart = ActiveChart


'Defining X and Y Axis values
Dim xRng As Range
Dim vRng1 As Range

With WS

Set xRng = .Range(.Cells(FirstRow, 3), .Cells(LastRow, 3))
Set vRng1 = .Range(.Cells(FirstRow, 2), .Cells(LastRow, 2))

End With


'Adding series 1
Chart.SeriesCollection.NewSeries
Chart.FullSeriesCollection(1).XValues = xRng
Chart.FullSeriesCollection(1).Values = vRng1
Chart.FullSeriesCollection(1).Name = "Score"


Chart.SetElement (msoElementLegendBottom)
Chart.SetElement (msoElementChartTitleAboveChart)
Selection.Caption = "User " & myValue & " Daily Score This Year"
Chart.Parent.Name = "DailyScore"
Chart.ChartArea.Select
Chart.Parent.Cut

Sheets("Dashboard").Select
Sheets("Dashboard").Activate
Range("K20").Select
ActiveSheet.Paste

Application.ScreenUpdating = True

End Sub


1 个答案:

答案 0 :(得分:1)

以应答方式编写此文本可帮助其他人: 跟随Set Chart = ActiveChart 添加ActiveChart.ChartArea.ClearContents 代码清空后,图表内容将清空,并在代码完成运行后返回期望的结果。