基于数据范围生成图表

我是一位在路易斯安那州的小型石油公司工作的地质学家。我构成了我们的技术部门，不幸的是我的编码经验非常有限。过去我使用过非常基本的vba编码，但在日常工作中我没有编写太多的代码，所以我已经忘记了大部分。我最近发现了这个网站，它已经成为我的一个很好的资源。我已经能够从以前对以前问题的回答中收集一些代码，但我再次陷入困境。基于数据范围生成图表

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

我的问题是每口井有不同数量的数据。例如，一口井将生产5年，而下一口井生产10口井。我需要能够生成一个宏，选择单元中的所有数据，然后绘制该数据。目前，无论何时我选择要绘制的列，excel都会尝试绘制整个列的图形，而不是仅绘制数据的范围，从而导致空间占主导地位的非常大的图形。列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

谢谢你并请让我知道我是否可以提供任何说明

来源

2015-01-03 Josiah Hulsey

作为一个方面说明，我知道我没有张贴代码的权利，但我无法弄清楚如何格式化代码才能在本网站上正确显示。我遵照指示，但似乎无法使其工作。任何建议在这里也不胜感激 –

在您用来撰写问题或答案的文本编辑器中，有一个用于嵌入代码的按钮。它在引号的右侧。只需将代码粘贴到编辑器中，突出显示所有内容，然后单击该按钮即可在大多数情况下使用。有时您可能不得不在段落中断之前结束行[ENTER]。参观。 http://stackoverflow.com/tour – peege

像这样的东西应该工作

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

来源

2015-01-03 19:00:16

蒂姆，非常感谢你的代码。它工作得很好！我有一个后续问题。我怎么能自动添加数据标签到图表？我怎么能改变编码，在Y轴上包含多个系列？ –

添的代码开裂。我学到了很多。约西亚，因为你出现新的节目，因为我读添的代码我已经添加了一些变化之下，你可能会从中受益：

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"))

来源

2015-01-03 21:19:24 HarveyFrench

基于数据范围生成图表

回答

相关问题