我有一个VBA代码，它只适用于前3个图。
我正在尝试在主工作表中使用VBA创建其他图形。首先，我有一个仪表板，我想有一个主表，总结一些我想搜索的名称，所以我的所有数据都在其他表中。此外，我想在主工作表中创建多个图形。
我创建了一个VBA IF条件，用于搜索特定名称，数据表中的名称如下：
数据表
考虑到这一点，我调暗了一个"；i〃；在数据表中查找我想要的名称。当有人想搜索名称1或名称2…时，该人将在主表中选择名称，单元格为："；C3"；。如果主表中的C3单元格等于数据表B2或Q2……则创建一个图表。
因此，适用于前3张图的代码是：
Private Sub worksheet_change(ByVal target As Range)
Dim cht As Chart, cht2 As Chart, cht3 As Chart, co As Object, co2 As Object, co3 As Object
Dim i As Long
Dim LastRow As Long, rngX As Range, rngY As Range, rngX2 As Range, rngY2 As Range, rngX3 As Range, rngY3 As Range
Dim LastColumn As Long, wsMain As Worksheet, wsData As Worksheet
Set wsData = ThisWorkbook.Worksheets("Data")
Set wsMain = ThisWorkbook.Worksheets("Main")
If target = wsMain.Cells(3, 3) Then
For i = 2 To 500 Step 15 'loop in increments of 15
If wsData.Cells(2, i) = wsData.Cells(4, 3) Then
'define data ranges
Set rngX = wsData.Range(wsData.Cells(6, i), wsData.Cells(Rows.Count, i).End(xlUp))
Set rngY = rngX.Offset(0, 1)
Set rngX2 = rngX
Set rngY2 = rngX2.Offset(0, 2)
Set rngX3 = rngX
Set rngY3 = rngX3.Offset(0, 3)
ClearWorksheetCharts wsMain 'remove any existing chart(s)
With wsMain.Range("B22:H37")
'add chartobject, setting position and size
Set co = .Worksheet.Shapes.AddChart(xlLine, .Left, .Top, _
.Width, .Height)
End With
With wsMain.Range("B39:H54")
'add chartobject, setting position and size
Set co2 = .Worksheet.Shapes.AddChart(xlLine, .Left, .Top, _
.Width, .Height)
End With
With wsMain.Range("B56:H71")
'add chartobject, setting position and size
Set co3 = .Worksheet.Shapes.AddChart(xlLine, .Left, .Top, _
.Width, .Height)
End With
Set cht = co.Chart
ClearChartSeries cht 'remove any "auto-added" series (if data was selected when chart was added)
AddSeries cht, "25%", rngX, rngY
AddSeries cht, "50%", rngX, rngY.Offset(0, 5)
AddSeries cht, "25%", rngX, rngY.Offset(0, 10)
cht.Axes(xlCategory).ReversePlotOrder = True
cht.HasTitle = True
cht.ChartTitle.Text = "1 month"
Set cht2 = co2.Chart
ClearChartSeries cht2 'remove any "auto-added" series (if data was selected when chart was added)
AddSeries cht2, "25% ", rngX2, rngY2
AddSeries cht2, "50%", rngX2, rngY2.Offset(0, 5)
AddSeries cht2, "25%", rngX2, rngY2.Offset(0, 10)
cht2.Axes(xlCategory).ReversePlotOrder = True
cht2.HasTitle = True
cht2.ChartTitle.Text = "2 months"
Set cht3 = co3.Chart
ClearChartSeries cht3 'remove any "auto-added" series (if data was selected when chart was added)
AddSeries cht3, "25%", rngX3, rngY3
AddSeries cht3, "50%", rngX3, rngY3.Offset(0, 5)
AddSeries cht3, "25%", rngX3, rngY3.Offset(0, 10)
cht3.Axes(xlCategory).ReversePlotOrder = True
cht3.HasTitle = True
cht3.ChartTitle.Text = "3 months"
End If
Next i
End If
End Sub
'add a series and name it (factored out from main sub)
Sub AddSeries(cht As Chart, serName As String, serX, serY)
With cht.SeriesCollection.NewSeries
.Name = serName
.XValues = serX
.Values = serY
End With
End Sub
'remove any existing series from a chart
Sub ClearChartSeries(cht As Chart)
Do While cht.SeriesCollection.Count > 0
cht.SeriesCollection(1).Delete
Loop
End Sub
'Remove any chart objects from `ws`
Sub ClearWorksheetCharts(ws As Worksheet)
Do While ws.ChartObjects.Count > 0
ws.ChartObjects(1).Delete
Loop
End Sub
然后我尝试在同一SUB:中添加其他3个不同的图
Private Sub worksheet_change(ByVal target As Range)
Dim cht As Chart, cht2 As Chart, cht3 As Chart, co As Object, co2 As Object, co3 As Object
Dim cht4 As Chart, cht5 As Chart, cht6 As Chart, co4 As Object, co5 As Object, co6 As Object
Dim i As Long
Dim LastRow As Long, rngX As Range, rngY As Range, rngX2 As Range, rngY2 As Range, rngX3 As Range, rngY3 As Range
Dim rngX4 As Range, rngY4 As Range, rngX5 As Range, rngY5 As Range, rngX6 As Range, rngY6 As Range
Dim LastColumn As Long, wsMain As Worksheet, wsData As Worksheet, wsData2 As Worksheet
Set wsData = ThisWorkbook.Worksheets("Data")
Set wsData2 = ThisWorkbook.Worksheets("Data2")
Set wsMain = ThisWorkbook.Worksheets("Main")
If target = wsMain.Cells(3, 3) Then
ClearWorksheetCharts wsMain 'remove any existing chart(s)
For i = 2 To 500 Step 15 'loop in increments of 15
If wsData.Cells(2, i) = wsMain.Cells(4, 3) Then
'define data ranges
Set rngX = wsData.Range(wsData.Cells(6, i), wsData.Cells(Rows.Count, i).End(xlUp))
Set rngY = rngX.Offset(0, 1)
Set rngX2 = rngX
Set rngY2 = rngX2.Offset(0, 2)
Set rngX3 = rngX
Set rngY3 = rngX3.Offset(0, 3)
With wsMain.Range("B22:H37")
'add chartobject, setting position and size
Set co = .Worksheet.Shapes.AddChart(xlLine, .Left, .Top, _
.Width, .Height)
End With
With wsMain.Range("B39:H54")
'add chartobject, setting position and size
Set co2 = .Worksheet.Shapes.AddChart(xlLine, .Left, .Top, _
.Width, .Height)
End With
With wsMain.Range("B56:H71")
'add chartobject, setting position and size
Set co3 = .Worksheet.Shapes.AddChart(xlLine, .Left, .Top, _
.Width, .Height)
End With
Set cht = co.Chart
ClearChartSeries cht 'remove any "auto-added" series (if data was selected when chart was added)
AddSeries cht, "25%", rngX, rngY
AddSeries cht, "50%", rngX, rngY.Offset(0, 5)
AddSeries cht, "25%", rngX, rngY.Offset(0, 10)
cht.Axes(xlCategory).ReversePlotOrder = True
cht.HasTitle = True
cht.ChartTitle.Text = "1 month"
Set cht2 = co2.Chart
ClearChartSeries cht2 'remove any "auto-added" series (if data was selected when chart was added)
AddSeries cht2, "25% ", rngX2, rngY2
AddSeries cht2, "50%", rngX2, rngY2.Offset(0, 5)
AddSeries cht2, "25%", rngX2, rngY2.Offset(0, 10)
cht2.Axes(xlCategory).ReversePlotOrder = True
cht2.HasTitle = True
cht2.ChartTitle.Text = "2 months"
Set cht3 = co3.Chart
ClearChartSeries cht3 'remove any "auto-added" series (if data was selected when chart was added)
AddSeries cht3, "25%", rngX3, rngY3
AddSeries cht3, "50%", rngX3, rngY3.Offset(0, 5)
AddSeries cht3, "25%", rngX3, rngY3.Offset(0, 10)
cht3.Axes(xlCategory).ReversePlotOrder = True
cht3.HasTitle = True
cht3.ChartTitle.Text = "3 months"
End If
Next i
For i = 2 To 500 Step 15 'loop in increments of 15
If wsData2.Cells(3, i) = wsMain.Cells(3, 3) Then
'define data ranges
Set rngX4 = wsData2.Range(wsData2.Cells(6, i), wsData2.Cells(Rows.Count, i).End(xlUp))
Set rngY4 = rngX4.Offset(0, 1)
Set rngX5 = rngX4
Set rngY5 = rngX5.Offset(0, 2)
Set rngX6 = rngX4
Set rngY6 = rngX6.Offset(0, 3)
With wsMain.Range("J22:P37")
'add chartobject, setting position and size
Set co4 = .Worksheet.Shapes.AddChart(xlLine, .Left, .Top, _
.Width, .Height)
End With
With wsMain.Range("J39:P54")
'add chartobject, setting position and size
Set co5 = .Worksheet.Shapes.AddChart(xlLine, .Left, .Top, _
.Width, .Height)
End With
With wsMain.Range("J56:P71")
'add chartobject, setting position and size
Set co6 = .Worksheet.Shapes.AddChart(xlLine, .Left, .Top, _
.Width, .Height)
End With
Set cht4 = co4.Chart
ClearChartSeries cht4 'remove any "auto-added" series (if data was selected when chart was added)
AddSeries cht4, "25%", rngX4, rngY4
AddSeries cht4, "50%", rngX4, rngY4.Offset(0, 5)
AddSeries cht4, "25%", rngX4, rngY4.Offset(0, 10)
cht4.Axes(xlCategory).ReversePlotOrder = True
cht4.HasTitle = True
cht4.ChartTitle.Text = "1 month"
Set cht5 = co5.Chart
ClearChartSeries cht5 'remove any "auto-added" series (if data was selected when chart was added)
AddSeries cht5, "25%", rngX5, rngY5
AddSeries cht5, "50%", rngX5, rngY5.Offset(0, 5)
AddSeries cht5, "25%", rngX5, rngY5.Offset(0, 10)
cht5.Axes(xlCategory).ReversePlotOrder = True
cht5.HasTitle = True
cht5.ChartTitle.Text = "2 months"
Set cht6 = co6.Chart
ClearChartSeries cht6 'remove any "auto-added" series (if data was selected when chart was added)
AddSeries cht6, "25%", rngX6, rngY6
AddSeries cht6, "50%", rngX6, rngY6.Offset(0, 5)
AddSeries cht6, "25%", rngX6, rngY6.Offset(0, 10)
cht6.Axes(xlCategory).ReversePlotOrder = True
cht6.HasTitle = True
cht6.ChartTitle.Text = "3 months"
End If
Next i
End If
End Sub
'add a series and name it (factored out from main sub)
Sub AddSeries(cht As Chart, serName As String, serX, serY)
With cht.SeriesCollection.NewSeries
.Name = serName
.XValues = serX
.Values = serY
End With
End Sub
'remove any existing series from a chart
Sub ClearChartSeries(cht As Chart)
Do While cht.SeriesCollection.Count > 0
cht.SeriesCollection(1).Delete
Loop
End Sub
'Remove any chart objects from `ws`
Sub ClearWorksheetCharts(ws As Worksheet)
Do While ws.ChartObjects.Count > 0
ws.ChartObjects(1).Delete
Loop
End Sub
但该代码只适用于这样的一些图：
图形
我做错了什么？为什么只有一些图表有效？非常感谢。
继续分解您的公共代码，您会发现它更容易进行故障排除。未测试，但试试这个：
Private Sub worksheet_change(ByVal target As Range)
Dim cht As Chart
Dim i As Long
Dim LastRow As Long, rngX As Range
Dim wsMain As Worksheet, wsData As Worksheet, wsData2 As Worksheet
Set wsData = ThisWorkbook.Worksheets("Data")
Set wsData2 = ThisWorkbook.Worksheets("Data2")
Set wsMain = ThisWorkbook.Worksheets("Main")
If target.Address <> wsMain.Cells(3, 3).Address Then Exit Sub 'not monitoring this cell
ClearWorksheetCharts wsMain 'remove any existing chart(s)
For i = 2 To 500 Step 15 'loop in increments of 15
If wsData.Cells(2, i) = wsData.Cells(4, 3) Then
Set rngX = wsData.Range(wsData.Cells(6, i), wsData.Cells(Rows.Count, i).End(xlUp))
Set cht = NewChart(wsMain.Range("B22:H37"), "1 month")
AddThreeSeries cht, rngX, rngX.Offset(0, 1)
Set cht = NewChart(wsMain.Range("B39:H54"), "2 months")
AddThreeSeries cht, rngX, rngX.Offset(0, 2)
Set cht = NewChart(wsMain.Range("B56:H71"), "3 months")
AddThreeSeries cht, rngX, rngX.Offset(0, 3)
End If
Next i
For i = 2 To 500 Step 15 'loop in increments of 15
If wsData2.Cells(2, i) = wsData.Cells(4, 3) Then
Set rngX = wsData2.Range(wsData.Cells(6, i), wsData2.Cells(Rows.Count, i).End(xlUp))
Set cht = NewChart(wsMain.Range("J22:P37"), "1 month")
AddThreeSeries cht, rngX, rngX.Offset(0, 1)
Set cht = NewChart(wsMain.Range("J39:P54"), "2 months")
AddThreeSeries cht, rngX, rngX.Offset(0, 2)
Set cht = NewChart(wsMain.Range("J56:P71"), "3 months")
AddThreeSeries cht, rngX, rngX.Offset(0, 3)
End If
Next i
End Sub
'add a new chart, and perform some common setup steps
Function NewChart(rng As Range, title As String) As Chart
Dim cht As Chart, co As Object
With rng
Set co = .Worksheet.Shapes.AddChart(xlLine, .Left, .Top, _
.Width, .Height)
End With
Set cht = co.Chart
ClearChartSeries cht
cht.Axes(xlCategory).ReversePlotOrder = True
cht.HasTitle = True
cht.ChartTitle.Text = title
Set NewChart = cht 'return the chart we just created
End Function
'wrap up common steps in a separate method
Sub AddThreeSeries(cht As Chart, rngX As Range, rngY As Range)
AddSeries cht, "25%", rngX, rngY
AddSeries cht, "50%", rngX, rngY.Offset(0, 5)
AddSeries cht, "25%", rngX, rngY.Offset(0, 10)
End Sub
'add a series and name it (factored out from main sub)
Sub AddSeries(cht As Chart, serName As String, serX, serY)
With cht.SeriesCollection.NewSeries
.Name = serName
.XValues = serX
.Values = serY
End With
End Sub
'remove any existing series from a chart
Sub ClearChartSeries(cht As Chart)
Do While cht.SeriesCollection.Count > 0
cht.SeriesCollection(1).Delete
Loop
End Sub
'Remove any chart objects from `ws`
Sub ClearWorksheetCharts(ws As Worksheet)
Do While ws.ChartObjects.Count > 0
ws.ChartObjects(1).Delete
Loop
End Sub