【问题标题】:Removing 'chartobjects' from 'chartobjects' object while looping循环时从“chartobjects”对象中删除“chartobjects”
【发布时间】:2021-05-28 00:44:20
【问题描述】:

我的 VBA 代码循环遍历一系列范围,并检查每个范围内是否只有一个图表,删除任何额外的图表。我想从正在循环的图表对象集合中删除我已经处理过的所有图表,如何从图表对象中删除图表对象?

这是我当前的代码。

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

【问题讨论】:

    标签: excel vba loops excel-charts


    【解决方案1】:

    已编辑 - 首先将所有图表放入一个集合中,以便您可以随时删除它们。

    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
    

    【讨论】:

    • 我希望能够减小循环遍历的数组的大小。在您的代码中,有 10 个框和 10 个图表,每个框检查每个图表,因此总共运行 100 次。如果我从循环中删除一个经过验证的图表,我会检查 10,然后是 9,然后是 8……所以总共只有 55 次运行。我的完整工作表大约有 60 个图表和 60 个方框,所以我正在寻找一种加快处理速度的方法。
    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2012-03-30
    • 1970-01-01
    • 2023-03-22
    • 2017-04-13
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多