Question

我有一个关于如何使用vba代码自动创建绘图（图表）的问题。我可以有一个包含两种列的Excel文档：可以分为6列的列或可以分组为7的列。前两张图片代表我如何收到excel文件。

我要做的是：

步骤1。复制A列并将其放在每组6或7列之前，并插入一个空列，如图3所示。

第2步。为在新工作表中创建的每个新组创建一个图表（例如，如果我有100组列，我想要有100张图表。每个图表都在一个片）

问题是： 如何将每个图表放在单独的表格中？

如果需要，第一张表的名称为“HOOD”

我编写的代码可以执行步骤1并创建绘图，但问题是我无法将每个图形放在一张纸上。

我可以执行第1步，从第2步开始，我只能创建图表，但我无法将每个图表都放在新工作表中。

6columns 7columns using vba code what i obtained

Sub Macro_Linearity_Plot()

        Dim pas As Integer
        Dim val As Integer

        Dim lCol As Integer
        Dim i As Integer
        Dim uCol As Integer


        ' define the numbers of columns. it can be 6 or 7 columns.

        lCol = Cells(1, Columns.Count).End(xlToLeft).Column
        val = Range("A1").Value
        pas = val + 2


        ' insert 2 new empty columns

        For colx = pas To lCol Step pas

        Columns(colx).Insert Shift:=xlToRight
        Columns(colx).Insert Shift:=xlToRight
        Next



        ' insert column number 1

        For colx = pas + 1 To lCol Step pas
        Sheets("HOOD").Columns(1).Copy
        Sheets("HOOD").Columns(colx).PasteSpecial xlPasteValues
        Next

        ' for every group of columns created at the last step generate a chart

        uCol = Cells(1, Columns.Count).End(xlToLeft).Column
        For i = -1 To uCol Step pas
        Range(Cells(2, i + 2), Cells(121, i + pas)).Select
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.SetSourceData Source:=Range(Cells(2, i + 2), Cells(121, i + pas))
        ActiveChart.ChartType = xl3DArea
        Next



        End Sub

谢谢：）

已更新

新代码是：

    Sub Macro_Linearity_Plot()

        Dim pas As Integer
        Dim val As Integer

        Dim lCol As Integer
        Dim i As Integer
        Dim uCol As Integer


        ' define the numbers of columns. it can be 6 or 7 columns.

        lCol = Cells(1, Columns.Count).End(xlToLeft).Column
        val = Range("A1").Value
        pas = val + 2


        ' insert 2 new empty columns

        For colx = pas To lCol Step pas

        Columns(colx).Insert Shift:=xlToRight
        Columns(colx).Insert Shift:=xlToRight
        Next



        ' insert column number 1

        For colx = pas + 1 To lCol Step pas
        Sheets("HOOD").Columns(1).Copy
        Sheets("HOOD").Columns(colx).PasteSpecial xlPasteValues
        Next

        ' for every group of columns created at the last step generate a chart

        uCol = Cells(1, Columns.Count).End(xlToLeft).Column
        For i = -1 To uCol Step pas


        Range(Cells(2, i + 2), Cells(121, i + pas)).Select
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.SetSourceData Source:=Range(Cells(2, i + 2), Cells(121, i + pas))
        ActiveChart.ChartType = xl3DArea
          xx = 1  'Just to identify the Graph order

ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Chart" & xx

'Count the sheets and Charts for moving Chart to the end
ws = ThisWorkbook.Worksheets.Count
cht = ThisWorkbook.Charts.Count

Sheets("Chart" & xx).Move After:=Sheets(ws + cht)

xx = xx + 1


        Next



        End Sub

但是有一些错误：

error debug

Answer 1

我查看并更改了原始脚本中的一些项目。

我对初始xx的设置不好，它需要在循环之前，否则它将始终为1.

我做了一些改变，我相信还有更好的方法：分配最后一列;请务必参考您要选择一组单元格的特定工作表等。

 Sub Macro_Linearity_Plot()

    Dim pas As Integer
    Dim val As Integer
    Dim lCol As Integer
    Dim i As Integer
    Dim uCol As Integer

    ' define the numbers of columns. it can be 6 or 7 columns.

    'You lCol script was worn got determine the last Column
    With ActiveSheet.UsedRange
        lCol = .Columns(.Columns.Count).Column
    End With
    'lCol = Cells(1, Columns.Count).End(xlToLeft).Column

    val = Range("A1").Value
    pas = val + 2

    ' insert 2 new empty columns

    For colx = pas To lCol Step pas
        Sheets("HOOD").Columns(colx).Insert Shift:=xlToRight
        Sheets("HOOD").Columns(colx).Insert Shift:=xlToRight
    Next

    ' insert column number 1

    For colx = pas + 1 To lCol Step pas
        Sheets("HOOD").Columns(1).Copy
        Sheets("HOOD").Columns(colx).PasteSpecial xlPasteValues
    Next

    ' for every group of columns created at the last step generate a chart

    uCol = Cells(1, Columns.Count).End(xlToLeft).Column

    xx = 1  'Just to identify the Graph order

    For i = -1 To uCol Step pas

        'Need top reselect the "HOOD" sheet for the range selection
        ActiveWorkbook.Sheets("HOOD").Select

        Sheets("HOOD").Range(Cells(2, i + 2), Cells(121, i + pas)).Select

        ActiveWorkbook.Sheets("HOOD").Shapes.AddChart.Select

        ActiveChart.SetSourceData Source:=Range(Cells(2, i + 2), Cells(121, i + pas))
        ActiveChart.ChartType = xl3DArea

        ChartName = "Graph Group " & xx
        ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=ChartName

        'Count the sheets and Charts for moving Chart to the end
        ws = ThisWorkbook.Worksheets.Count
        cht = ThisWorkbook.Charts.Count

        Sheets(ChartName).Move After:=Sheets(ws + cht)

        xx = xx + 1

    Next i

End Sub

Answer 2

使用非限定范围时，您遇到的问题通常是。不合格的范围是指活动工作表，每次插入新工作表时都会更改，因此代码会在第一次循环后开始乱码。

起初我已经通过＆＃34;在每次循环后重新激活表单HOOD来修复代码，但我更喜欢完全重写代码以便它除了一些其他修正之外，从不引用不合格的范围。

Sub Macro_Linearity_Plot() Dim pas As Integer, val As Integer, lCol As Integer, i As Integer, ch As Chart With Sheets("HOOD") lCol = .Cells(2, .Columns.Count).End(xlToLeft).Column val = .Range("A1").Value pas = val + 2 ' insert an empty column and a copy of column A For colx = pas To lCol Step pas .Columns(colx).Insert Shift:=xlToRight .Columns(colx).Insert Shift:=xlToRight .Columns(1).copy .Columns(colx + 1) Next Application.CutCopyMode = False ' for every group of columns generate a chart and move it to end of Workbook lCol = .Cells(1, Columns.Count).End(xlToLeft).Column For i = -1 To lCol Step pas Set ch = ActiveWorkbook.Charts.Add '<~~ add a chart in own new sheet ch.ChartType = xl3DArea ch.SetSourceData .Range(.Cells(2, i + 2), .Cells(121, i + pas)) ch.name = "Chart" & CInt(1 + (i + 2) / pas) ch.Move , ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count) Next End With End Sub

适用于Excel的VBA代码。如何在单独的表格中创建图表？

2 个答案: