Блог

Мой код VBA перебирает последовательность диапазонов и проверяет, что внутри каждого диапазона находится только одна диаграмма, удаляя все дополнительные диаграммы. Я хотел бы удалить все диаграммы, с которыми я уже имел дело, из коллекции chartobjects, которую я просматриваю, как удалить объект chartobject из объекта chartobjects?

Вот мой текущий код.

 Dim ChartsNotChecked As ChartObjects
Dim ChartsChecked As ChartObjects

Dim i As Long
Dim j As Long

Dim ChartBox As Range
Dim Char As ChartObject
Dim FirstChart As ChartObject
Dim OneFound As Boolean

Set ChartsNotChecked = ActiveSheet.ChartObjects
For j = 10 To 100 Step 10
    Set ChartBox = Range(Cells(1, j - 9), Cells(10, j))
    
    OneFound = False
    
    For Each Char In ChartsNotChecked
        
        If Not Intersect(Char.TopLeftCell, ChartBox) Is Nothing Then 'check if chart intersects current chartbox
            
            If Not OneFound Then 'catches first intersecting chart automatically
            
                Set FirstChart = Char
                OneFound = True
            
            Else
                If Not FirstChart Is Nothing Then Char.Delete 'deletes any other charts
            
            End If
        End If
        
    Next Char

'format FirstChart    
'remove FirstChart from ChartsNotChecked
'add FirstChart to ChartsChecked

Next j
 

ОТРЕДАКТИРОВАНО — сначала поместите все диаграммы в коллекцию, чтобы вы могли удалять их по ходу работы.

 Sub GG()
    
    Dim allCharts As New Collection
    Dim ChartsChecked As New Collection
    Dim i As Long, j As Long
    Dim ChartBox As Range
    Dim Char As ChartObject
    Dim OneFound As Boolean, ws As Worksheet
    
    Set ws = ActiveSheet
    
    'make a collection of all chartobjects
    For Each Char In ws.ChartObjects
        allCharts.Add Char
    Next Char
    
    For j = 10 To 100 Step 10
        Set ChartBox = ws.Range(ws.Cells(1, j - 9), ws.Cells(10, j))
        OneFound = False
        For i = allCharts.Count To 1 Step -1 'work backwards
            Set Char = allCharts(i)
            If Not Intersect(Char.TopLeftCell, ChartBox) Is Nothing Then 'check if chart intersects current chartbox
                If Not OneFound Then 'catches first intersecting chart
                    OneFound = True
                Else
                    Char.Delete 'deletes any other charts
                End If
                allCharts.Remove i 'remove from collection: was kept or deleted
            End If
        Next i
    Next j
End Sub