Agregar series automáticamente a Gráfica
Buen dia estimado experto
Tengo un código macro el cual se utiliza en una hoja de cálculo en donde están las columnas Polígono, Vértice, X , Y. Pues bien, la macro crea una gráfica de dispersión (xy) que contiene una cantidad de series igual al número de polígonos que tiene dicha hoja.
Mi problema surge, que tengo que agregar una nueva tabla (con el mismo formato de la primera) a 5 columnas separada de la primera y no logro encontrar que debo modificar en el código para que se agreguen los nuevos polígonos al gráfico.
Paso a dejar el código que estoy utilizando
Desde ya muchas gracias por su ayuda.
Saludos
Sub prueba()
Dim p As Range
Dim poligono As Excel.Chart
Dim serie_p As Excel.Series
With ActiveSheet
'Se crea un gráfico y lo asigna a la variable polígono
Set poligono = .ChartObjects.Add(Left:=100, Width:=375, Top:=75, Height:=225).Chart
'Se establece el tipo de gráfico
poligono.ChartType = xlXYScatterLines
'El rango de datos con el que se va a trabajar
With .Range("a1").CurrentRegion
'Desactiva la actualización de pantalla
Application.ScreenUpdating = False
'Se filtran los valores únicos de la columna 1 del rango de datos
'con el que se va a trabajar
.Columns(1).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
'Se inicia un bucle que va a recorrer todos los valores únicos
'de la columna 1 del rango con el que se está trabajando
For Each p In .Offset(1).Resize(.Rows.Count - 1).Columns(1).SpecialCells(xlCellTypeVisible)
'Se crea una nueva serie y se asigna a la variable serie_p
Set serie_p = poligono.SeriesCollection.NewSeries
'Se filtran los datos por el valor con el que se
'está trabajando
.AutoFilter field:=1, Criteria1:=p
'El rango de datos excluyendo los encabezados
With .Offset(1).Resize(.Rows.Count - 1)
'Se asigna el nombre a la nueva serie
serie_p.Name = .SpecialCells(xlCellTypeVisible).Cells(1, 1)
'Se asignan los valores para el eje X a la serie
serie_p.XValues = .Columns(3).SpecialCells(xlCellTypeVisible)
'Se asignan los valores para el eje Y a la serie
serie_p.Values = .Columns(4).SpecialCells(xlCellTypeVisible)
'Se muestran las etiquetas para la serie
serie_p.ApplyDataLabels
End With
'Se libera la memoria de la serie con la que acabamos de trabajar
Set serie_p = Nothing
'Se pasa al siguiente dato único para repetir el bucle y crear una nueva serie con él
Next p
'Quita los filtros de la hoja
.AutoFilter
'Se activa la actualización de pantalla
Application.ScreenUpdating = True
End With
'Se libera la memoria
Set poligono = Nothing
End With
End Sub