使用Excel中图表的目标工作表数据将图表从一张工作表复制到另一张工作表 [英] Copy a chart from one sheet to another using the target sheet data for the chart in Excel

问题描述

我有几个工作表，这些工作表具有不同的数据，但以相同的方式组织(相同的col和行数).我在工作表sheet1中创建了多个图表，我想将这些图表复制到工作表sheet2中.虽然正常的复制/粘贴将图表复制到sheet2，但图表仍引用Sheet1中的数据，而不是Sheet2中的数据.复制后如何自动让他们使用sheet2数据而不是工作表?

I have several worksheets which have different data but organized in the same way (same number of col and rows). I created several charts in sheet1 which I would like to copy to sheet2. while the normal copy/paste copies the charts to sheet2, the charts is still referring to data in sheet1, not in sheet2. How can I automatically make them use sheet2 data rather than sheet after copying?

作为一种变通方法，我尝试复制sheet1并将其命名为sheet2(它将复制所有数据和图表)，然后将实际的sheet2数据复制并粘贴到此新表中.可以，但是我希望有一种更快的方法，也许是一个宏，可以将所有图表从sheet1复制到sheet2并自动更新引用.

As a work around, I tried copying sheet1 and called it sheet2 (which copies all data and charts), then copy and pasted the real sheet2 data in this new sheet. This works, but I was hoping there is a faster way and perhaps a macro that copies all charts from sheet1 to sheet2 and automatically updates the references.

推荐答案

所以这样对我有用. CopyCharts将所有图表从源工作表复制到目标工作表.然后SetChartRef将目标中图表的引用设置为我想要的图表.在此示例中，我知道哪个图表编号是什么.我想可以对其进行改进，以便改用图表名称.

So something like this worked for me. CopyCharts copies all charts from a source sheet to a target sheet. Then SetChartRef sets the reference of the charts in the target to what I want them to be. In this example I know which chart number is what. I guess it can be improved so that it uses the chart names instead.

此外，由于某些原因，如果我在复制和粘贴之间没有延迟，则会出现运行时错误，因此会有等待功能.

Also, for some reason I get run time errors if I don't have delays between copying and pasting, hence the wait functions.

    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

这篇关于使用Excel中图表的目标工作表数据将图表从一张工作表复制到另一张工作表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！