使用Excel中图表的目标工作表数据将图表从一个工作表复制到另一个工作表

Ari*_*Ari 6 excel vba excel-vba

我有几个工作表,它们具有不同的数据,但以相同的方式组织(相同数量的col和行).我在sheet1中创建了几个图表,我想复制到sheet2.正常的复制/粘贴将图表复制到sheet2时,图表仍然是指sheet1中的数据,而不是sheet2中的数据.如何在复制后自动使用sheet2数据而不是表格?

作为解决方法,我尝试复制sheet1并将其称为sheet2(复制所有数据和图表),然后将真实的sheet2数据复制并粘贴到此新工作表中.这是有效的,但我希望有一种更快的方法,也许是一个将所有图表从sheet1复制到sheet2并自动更新引用的宏.

Jon*_*ier 8

将图表复制到另一个工作表并使图表链接到新工作表上的数据的最简单方法是不复制图表.最简单的方法是复制包含图表的工作表,然后更改复印工作表上的数据.

第二种最简单的方法,如果简单地组织图表的数据,则使用功能区或右键单击菜单中的选择数据,并更改对话框顶部的图表数据范围RefEdit中指示的范围.

一种繁琐的方法是更改​​所有图表系列公式中的所有工作表引用,例如,将以下公式中的Sheet1的所有实例更改为Sheet2:= SERIES(Sheet1!$ B $ 1,Sheet1!$ A $ 2:$一个$ 4工作表Sheet1 $ B $ 2:$ B $ 4,1)

正如@ sancho.s指出的那样,你也可以使用我的Change Series Formula教程中发布的代码与VBA一起做.这些算法内置于我的商业Excel插件软件中.


Ari*_*Ari 1

所以这样的事情对我有用。CopyCharts 将所有图表从源工作表复制到目标工作表。然后 SetChartRef 将目标中图表的引用设置为我想要的值。在这个例子中我知道哪个图表编号是什么。我想它可以改进,以便它使用图表名称来代替。

另外,由于某种原因,如果复制和粘贴之间没有延迟,我会遇到运行时错误,因此需要等待函数。

    Sub DeleteEmbeddedCharts(target As String)

    Dim wsItem As Worksheet
    Dim chtObj As ChartObject
        For Each chtObj In ThisWorkbook.Worksheets(target).ChartObjects
            chtObj.Delete
        Next
End Sub

Sub SetChartRef(target As String)

    Dim cht As ChartObject
    Dim i As Integer

    'i specifies which chart to set its data references
    i = 0
    For Each cht In ThisWorkbook.Worksheets(target).ChartObjects
        If i = 0 Then
            cht.Chart.SeriesCollection(1).Values = "=" & target & "!$I$2:$I$12"
            cht.Chart.SeriesCollection(2).Values = "=" & target & "!$J$2:$J$12"
        ElseIf i = 1 Then
             cht.Chart.SeriesCollection(1).Values = "=" & target & "!$I$14:$I$25"
             cht.Chart.SeriesCollection(2).Values = "=" & target & "!$J$14:$J$25"
        ElseIf i = 2 Then
            cht.Chart.SeriesCollection(1).Values = "=" & target & "!$I$26:$I$37"
            cht.Chart.SeriesCollection(2).Values = "=" & target & "!$J$26:$J$37"
        ElseIf i = 3 Then
            cht.Chart.SeriesCollection(1).Values = "=(" & target & "!$H$2," & target & "!$H$14," & target & "!$H$26," & target & "!$H$38)"
            cht.Chart.SeriesCollection(1).XValues = "=(" & target & "!$E$2," & target & "!$E$14," & target & "!$E$26," & target & "!$E$38)"
         ElseIf i = 4 Then
            cht.Chart.SeriesCollection(1).Values = "=(" & target & "!$H$2," & target & "!$H$14," & target & "!$H$26," & target & "!$H$38)"
            cht.Chart.SeriesCollection(1).XValues = "=(" & target & "!$E$2," & target & "!$E$14," & target & "!$E$26," & target & "!$E$38)"
        ElseIf i = 5 Then
            cht.Chart.SeriesCollection(1).Values = "=" & target & "!$I$38:$I$49"
            cht.Chart.SeriesCollection(2).Values = "=" & target & "!$J$38:$J$49"
        End If
        i = i + 1
    Next


End Sub

Sub CopyCharts(source As String, target As String)

    Dim chtObj As ChartObject
    'First delete all charts from target sheet
    DeleteEmbeddedCharts (target)

    'Some delay
    Application.Wait Now + TimeSerial(0, 0, 1)

    For Each chtObj In ThisWorkbook.Worksheets(source).ChartObjects
        With ThisWorkbook.Worksheets(target)
            .Activate
            chtObj.Copy
            'Paste in row T1+i
            Range("T1").Offset(i).Select
            .Activate
            Application.Wait Now + TimeSerial(0, 0, 1)
            .Paste
            Application.Wait Now + TimeSerial(0, 0, 1)
            i = i + 10
            .Activate
        End With
    Next chtObj

    'Set the data references to target sheet
    SetChartRef (target)

End Sub
Run Code Online (Sandbox Code Playgroud)