使用 VBA 循环从大型数据集创建多个图形
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/24251434/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Creating multiple graphs from a large data set using VBA looping
提问by user3746074
I am trying to create a macro in VBA that will take a large data set in Sheet1 (called Raw Data) and create a XY scatter plot for every 8000 data points in another worksheet. The macro will also need to label each graph with what range it represents (ie 1-8000, 8001-16000 etc).
我正在尝试在 VBA 中创建一个宏，它将在 Sheet1（称为原始数据）中获取一个大数据集，并为另一个工作表中的每 8000 个数据点创建一个 XY 散点图。宏还需要用它代表的范围（即 1-8000、8001-16000 等）标记每个图形。
The large data set consists of temperature readings from 8 different thermocouples which record data every second. The number of data points will vary based on how long the experiment was run. The temperature values are stored in columns C through J and the time parameter is in column T.
大数据集由 8 个不同热电偶的温度读数组成，这些热电偶每秒记录数据。数据点的数量将根据实验运行的时间而有所不同。温度值存储在 C 到 J 列中，时间参数存储在 T 列中。
What I have right now is a "batch" approach where the macro is set up to graph data in chunks of 8000 up to 32000 (4 different plots). This approach is not practical because the data set will almost always be significantly larger than 32000 points.
我现在拥有的是一种“批处理”方法，其中宏设置为以 8000 到 32000（4 个不同的图）的块为单位绘制数据。这种方法并不实用，因为数据集几乎总是明显大于 32000 个点。
What I would like the macro to do is automatically graph and label every 8000 data points until there is no more data to graph.
我希望宏做的是每 8000 个数据点自动绘制和标记，直到没有更多的数据可以绘制。
I have been looking into using a loop but I am new to writing code and not sure how.
我一直在研究使用循环，但我是编写代码的新手，不确定如何使用。
Any suggestions or help is greatly appreciated!
非常感谢任何建议或帮助！
Here's some of my batch code:
这是我的一些批处理代码：
'creates graph for first 8000 seconds in TC 1
Sheets("TC 1").Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).Name = "='Raw Data'!$C"
ActiveChart.SeriesCollection(1).XValues = "='Raw Data'!$t:$t00"
ActiveChart.SeriesCollection(1).Values = "='Raw Data'!$C:$C00"
With ActiveChart
'X axis name
.axes(xlCategory, xlPrimary).HasTitle = True
.axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Time (seconds)"
'y-axis name
.axes(xlValue, xlPrimary).HasTitle = True
.axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Temperature (F)"
'chart title
.HasTitle = True
.ChartTitle.Text = ("1-8000 seconds")
'adjusts the size/placement of graph and x-axis values
Set RngToCover = ActiveSheet.Range("A1:T25")
Set ChtOb = ActiveChart.Parent
ChtOb.Height = RngToCover.Height ' resize
ChtOb.Width = RngToCover.Width ' resize
ChtOb.Top = RngToCover.Top ' repositon
ChtOb.Left = RngToCover.Left ' reposition
ActiveChart.axes(xlCategory).Select
ActiveChart.axes(xlCategory).MinimumScale = 0
ActiveChart.axes(xlCategory).MaximumScale = 8000
End With
采纳答案by user3746074
Here is what I came up with.
这是我想出的。
The macro calculates the total number of used rows, then divides that number by 8000.
该宏计算使用的总行数，然后将该数字除以 8000。
The For...Next loop runs from 0 to the total rows divided by 8000.
For...Next 循环从 0 运行到总行数除以 8000。
Dim i As Integer
Dim j As Variant
Dim p As Integer
Dim start_row As Long
Dim end_row As Long
Dim RngToCover As Range
Dim ChtOb As ChartObject
i = Worksheets("Raw Data").UsedRange.Rows.Count
j = i / 8000
Sheets("TC 1").Activate
For p = 0 To j
start_row = (p * 8000) + 2
end_row = ((p + 1) * 8000) + 1
Set ChtOb = ActiveSheet.ChartObjects.Add(Left:=20, Width:=800, Top:=20, Height:=250)
ChtOb.Chart.ChartType = xlXYScatterSmoothNoMarkers
ChtOb.Activate
With ActiveChart.SeriesCollection.NewSeries
.Name = Worksheets("Raw Data").Cells(1, 3)
.XValues = Worksheets("Raw Data").Range(Worksheets("Raw Data").Cells(start_row, 20), Worksheets("Raw Data").Cells(end_row, 20))
.Values = Worksheets("Raw Data").Range(Worksheets("Raw Data").Cells(start_row, 3), Worksheets("Raw Data").Cells(end_row, 3))
End With
Next
回答by Mark Balhoff
It sounds like you already understand how to generate the charts for a given 8000 records. Below is a WHILE loop to keep running your export code until it finds an empty cell in the source column for the X-axis (column T).
听起来您已经了解如何为给定的 8000 条记录生成图表。下面是一个 WHILE 循环，用于继续运行您的导出代码，直到它在 X 轴（T 列）的源列中找到一个空单元格。
Dim i As Integer
Dim ws As Worksheet
i = 2
Set ws = ThisWorkbook.Worksheets("Raw Data")
While ws.Cells(i, 20).Value <> ""
''' Create Chart for Next Data Set Starting at Row i (up to 8000 records)
i = i + 8000
Wend
