使用VBA循环从大型数据集创建多个图形

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$1"
ActiveChart.SeriesCollection(1).XValues = "='Raw Data'!$t$2:$t$8000"
ActiveChart.SeriesCollection(1).Values = "='Raw Data'!$C$2:$C$8000"

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

2 个解决方案

#1

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

#2

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

#1