根据数据范围生成图表

Question

我是路易斯安那州一家小型石油公司的地质学家。我组成了我们的技术部门，不幸的是我在编码方面的经验非常有限。我过去使用过非常基本的 vba 编码，但我在日常工作中编码不多，所以我忘记了大部分。我最近发现了这个网站，它已成为我的重要资源。我已经能够从以前对以前问题的回答中收集到一些代码片段，但我又一次被卡住了。

我的整个宏的重点是从外部数据库检索石油生产数据，根据所述数据计算某些值，然后创建显示数据某些方面的图表。我有实现前 2 个目标的代码，但我正在为自动化图形制作过程的代码而苦苦挣扎。

我的问题是每个孔的数据量不同。例如，一口井将生产 5 年，而下一口井将生产 10 年。我需要能够制作一个宏，其中包含 select 单元格中的所有数据，然后绘制该数据的图表。目前，每当我 select 列绘制图表时，excel 将尝试绘制整个列而不是我的数据范围，这会导致非常大的图表主要是空白 space。 J 列需要是 X 轴，L 列需要是 Y 轴。 J 列有文字和数字，L 列只有数字

此外，我希望宏使用工作表名称和我将输入的字符串生成图表名称。生成的所有图表的字符串都相同。我希望图表与标记图表一致。

命名过程的一个例子是这样的

工作表名称

油价下跌百分比

下面是我目前生成的代码：

Sub automated_graphs()
'
' automated_graphs Macro
'

'
    Range("L:L,J:J").Select
    Range("J1").Activate
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlLineMarkers
    ActiveChart.SetSourceData Source:=Range( _
        "'EP Allen 1'!$L:$L,'EP Allen 1'!$J:$J")
    ActiveChart.Axes(xlCategory).Select
    ActiveChart.SeriesCollection(1).Delete
    ActiveChart.SeriesCollection(1).XValues = "='EP Allen 1'!$J:$J"
    ActiveChart.ChartTitle.Select
    ActiveChart.ChartTitle.Text = "Worksheet Name here" & Chr(13) & "Oil Production by year"
    Selection.Format.TextFrame2.TextRange.Characters.Text = _
        "Worksheet Name here" & Chr(13) & "Oil Production by year"
    With Selection.Format.TextFrame2.TextRange.Characters(1, 20).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 20).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(21, 22).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(21, 3).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(24, 19).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    ActiveChart.SeriesCollection(1).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 176, 80)
        .Transparency = 0
        .Solid
    End With
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 176, 80)
        .Transparency = 0
    End With
End Sub

谢谢，如果我可以就任何要点提供任何说明，请告诉我

Answer 1

像这样的东西应该可以工作

Sub DoChart()

Dim sht As Worksheet
Dim xVals As Range, yVals As Range
Dim co As Shape, cht As Chart, s As Series

    Set sht = ActiveSheet
    Set co = sht.Shapes.AddChart()
    Set cht = co.Chart

    'remove any existing series
    Do While cht.SeriesCollection.Count > 0
        cht.SeriesCollection(1).Delete
    Loop 

    cht.ChartType = xlLineMarkers

    'get the extent of the XValues...
    Set xVals = sht.Range(sht.Range("J2"), sht.Cells(Rows.Count, "J").End(xlUp))
    Set yVals = xVals.Offset(0, 2)

    Set s = cht.SeriesCollection.NewSeries
    s.XValues = xVals
    s.Values = yVals

    With s.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 176, 80)
        .Transparency = 0
        .Solid
    End With
    With s.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 176, 80)
        .Transparency = 0
    End With

    cht.HasLegend = False

    cht.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
    cht.Axes(xlCategory, xlPrimary).AxisTitle.Text = "Year"

    cht.SetElement (msoElementPrimaryValueAxisTitleRotated)
    cht.Axes(xlValue, xlPrimary).AxisTitle.Text = "Production"

    cht.SetElement (msoElementChartTitleCenteredOverlay)
    With cht.ChartTitle
        .Text = sht.Name & Chr(10) & "Oil Production by year"
        .Characters.Font.Size = 12
    End With

End Sub

Answer 2

Tim 的代码正在破解。我学到了很多。 Josiah，由于您在我阅读 Tim 的代码时似乎是编程新手，所以我在下面添加了一些更改，您可能会从中受益：

Set xVals = sht.Range(sht.Range("J2"), sht.Cells(SHT.Rows.Count, "J").End(xlUp))  
' Added SHT for completeness.

Set yVals = xVals.Offset(0, 2)  
' THE ABOVE LINE WORKS BUT REPLACING WITH THE LINE BELOW MAKES IT MORE ROBUST AS 
' YOU SIMPLY CHANGE "J" to be "X" if the data moves from column J to column X.

Set yVals = intersect(xVals.entirerow, sht.columns("J"))

根据数据范围生成图表

Generating graphs based on data extent

excel

vba