问使用宏从Excel中的选定数据范围绘制包含两个系列的图形

EN

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'Double-click cell to update chart
'You need to create a dynamic range and refer to that range as the pivottable data source
'For this to work you need to create a pivot table and a pivot table chart

If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub 'code will only run if values in col A are double clicked

On Error GoTo ErrorHandler

Dim Pt As PivotTable                                        'refer to pivottables as shorter text 'Pt'
Dim Fd As PivotField                                        'refer to pivottable fields as shorter text 'Fd'
Dim FilterChoice As String                                  'declare that a text string will be used as the filter choice

Set Pt = ActiveSheet.PivotTables("PivotTable3")         'tell this code where the pivottable is and what its called
Set Fd = Pt.PivotFields("Gene Name")                    'tell this code what pivottable field you are changing
FilterChoice = CStr(ActiveCell)                         'tell this code that the pivottable filter is the text in the cell you double-click

    With Pt                                             'these lines refresh the pivottable after you have double clicked
    Fd.ClearAllFilters
    Fd.CurrentPage = FilterChoice
    Pt.RefreshTable
    End With

ActiveSheet.ChartObjects("Gene_Chart").Activate             'Sets the chart title. Name the chart as 'Gene_Chart' first
ActiveChart.SetElement (msoElementChartTitleAboveChart)
ActiveChart.charttitle.Text = CStr(ActiveCell)

ErrorExit:
Exit Sub

ErrorHandler:
    msgbox "Dont click on an empty cell"

ActiveSheet.ChartObjects("Gene_Chart").Activate             'Sets the chart title. Name the chart as 'Gene_Chart' first
ActiveChart.SetElement (msoElementChartTitleAboveChart)
ActiveChart.charttitle.Text = "All"

Resume ErrorExit

End Sub