如何使用VBA创build具有dynamic范围大小的多个embedded式折线图

这是我的问题。 我设法创build了一个如下所示的macros：

Sub Macro1() Range("G17:G36").Select ActiveSheet.Shapes.AddChart.Select ActiveChart.SetSourceData Source:=Range("'Sheet1'!$G$17:$G$36") ActiveChart.ChartType = xlLine End Sub 

我知道这是非常基本的logging，但我的问题是如何改变它，使范围dynamic和条件。 例如，当我到达第17行时，单元格D17中的值大于可以说的200，而E17的值大于100.这应该触发我的范围的开始。 所以如果D17>200 AND E17>100我需要得到G17作为范围的开始。 至于G36 （范围结束）的逻辑是非常相似的，但这次我会testing这样的条件： IF F36<64 THEN得到G36作为范围的结束。 应该重复，直到最后。 例如，最后一行可能是28000，所以我预计这些图表中有很多会一直创build。

感谢您的帮助，Schroedinger。

这是它现在的样子，给我一个运行时错误在我与EngJon的通信中解释。

 Sub GenerateCharts() Application.ScreenUpdating = False 'Get the last row Dim LastRow As Long LastRow = ActiveSheet.UsedRange.Rows.Count Dim endOfRange As Long Dim wholeRange As Range Dim i As Long For i = 1 To LastRow If Cells(i, 4) > 0.000001 And Cells(i, 5) > 0.00000002 Then 'Determine the end of the range endOfRange = DetermineRange(i) Set wholeRange = Range(Cells(i, 7), Cells(endOfRange, 7)) NewChart (wholeRange) i = endOfRange End If Next i Application.ScreenUpdating = True End Sub Function DetermineRange(row As Long) As Long Dim LastRow As Long LastRow = ActiveSheet.UsedRange.Rows.Count Dim j As Long For j = row To LastRow If Cells(j, 6) < -0.0000000018 Then DetermineRange = j Exit Function End If Next j DetermineRange = j End Function Function NewChart(rng As Range) ActiveSheet.Shapes.AddChart.Select ActiveChart.SetSourceData Source:=rng ActiveChart.ChartType = xlLine End Function 

这对我来说是最终的解决scheme。 我希望它可以帮助别人。 对EngJon和Paagua格兰特大tnx。

 Sub GenerateCharts() Application.ScreenUpdating = False Dim StartCell As Long Dim EndCell As Long Dim ChartRange As Range Dim DataEnd As Long Dim i As Integer Dim j As Integer Dim HasStart As Boolean Dim HasEnd As Boolean 'Sets end of data based on the row you are charting DataEnd = Cells(Rows.Count, 7).End(xlUp).Row 'Begin loop to find start and end ranges, create charts based on those ranges For i = 1 To DataEnd If HasStart Then If Cells(i, 4).Value < 0 Then EndCell = i HasEnd = True End If Else 'If there isn't a starting cell yet If Cells(i, 4).Value > 0.000001 And Cells(i, 5).Value > 0.00000002 Then StartCell = i HasStart = True End If End If If HasStart And HasEnd Then Set ChartRange = ActiveSheet.Range(Cells(StartCell, 7), Cells(EndCell, 7)) ActiveSheet.Shapes.AddChart(xlLine, _ Left:=ActiveSheet.Range(Cells(StartCell, 10), Cells(StartCell, 10)).Left, _ Top:=ActiveSheet.Range(Cells(StartCell, 10), Cells(StartCell, 10)).Top, _ Width:=ActiveSheet.Range(Cells(StartCell, 10), Cells(StartCell, 20)).Width, _ Height:=ActiveSheet.Range(Cells(StartCell, 10), Cells(StartCell + 25, 10)).Height _ ).Select ActiveChart.SetSourceData Source:=ChartRange HasStart = False HasEnd = False End If Next Application.ScreenUpdating = True End Sub 

Answer 1

您可以使用录制的Macro1作为函数，并在需要创build新图表时调用它：

 Function NewChart(rng As Range) ActiveSheet.Shapes.AddChart.Select ActiveChart.SetSourceData Source:=rng ActiveChart.ChartType = xlLine End Function 

您还需要以下function：

 Function DetermineRange(row As Long) As Long Dim LastRow As Long LastRow = ActiveSheet.UsedRange.Rows.Count Dim j As Long For j = row To LastRow If Cells(j, 6) < 64 Then DetermineRange = j Exit Function End If Next j DetermineRange = j End Function 

你将在一个Sub中调用它遍历所有行：

 Sub GenerateCharts() Application.ScreenUpdating = False 'Get the last row Dim LastRow As Long LastRow = ActiveSheet.UsedRange.Rows.Count Dim endOfRange As Long Dim wholeRange As Range Dim i As Long For i = 1 To LastRow If Cells(i, 4) > 200 And Cells(i, 5) > 100 Then 'Determine the end of the range endOfRange = DetermineRange(i) Set wholeRange = Range(Cells(i, 7), Cells(endOfRange, 7)) NewChart wholeRange i = endOfRange End If Next i Application.ScreenUpdating = True End Sub 

将这三个复制到模块中并执行Sub。 请评论，如果这做了你所需要的。

Answer 2

这是一个稍微不同的选项，可以在一个函数中执行所有的任务。

  Option Explicit Private Sub CommandButton1_Click() Application.ScreenUpdating = False Dim StartCell As Long, EndCell As Long, ChartRange As Range, DataEnd As Long, i As Integer, j As Integer, HasStart As Boolean, HasEnd As Boolean, _ ChartTop As Long, ChartHeight As Long DataEnd = Cells(Rows.Count, 7).End(xlUp).Row 'Sets end of data based on the row you are charting. ChartTop = 50 ChartHeight = 100 'Begin loop to find start and end ranges, create charts based on those ranges. For i = 1 To DataEnd If HasStart Then If Cells(i, 6).Value < 64 Then EndCell = i HasEnd = True End If Else 'If there isn't a starting cell yet. If Cells(i, 7).Value > 200 And Cells(i, 5).Value > 100 Then StartCell = i HasStart = True End If End If If HasStart And HasEnd Then Set ChartRange = ActiveSheet.Range(Cells(StartCell, 7), Cells(EndCell, 7)) ActiveSheet.Shapes.AddChart(Top:=ChartTop, Height:=ChartHeight).Select With ActiveChart .SetSourceData Source:=ChartRange .ChartType = xlLine End With ChartTop = ChartTop + ChartHeight + 15 HasStart = False HasEnd = False End If Next Application.ScreenUpdating = True End Sub 

这也确保了由该工具创build的每个图表不会与前面的图表重叠。

为了空间和清晰起见，我正在回应你的后续问题。

假设标准行高和列宽，可以设置

 ChartTop =(StartCell-1)*15 

将图表的顶部设置为从数据的同一行的顶部开始，并在图表的顶部

 ActiveSheet.Shapes.AddChart(Top:=ChartTop, Height:=ChartHeight).Select 

你可以加

 Left:=(X * 48) 

其中X是比图表左alignment的列号小1，例如，如果要让图表从列I的左边缘开始，则X将等于8.但是，就我而言可以告诉，如果行高/列宽不是标准的，例如，如果自动将列填充到数据中，则没有简单的方法来调整这些值。