Question

我正在尝试在VBA中创建一个宏，它将获取Sheet1中的大数据集（称为原始数据），并为另一个工作表中的每8000个数据点创建一个XY散点图。宏还需要将每个图形标记为它所代表的范围（即1-8000,8001-16000等）。

大数据集包括来自8个不同热电偶的温度读数，每秒记录数据。数据点的数量将根据实验运行的时间而变化。温度值存储在C到J列中，时间参数在T列中。

我现在所拥有的是一种“批处理”方法，其中宏被设置为以8000到32000（4个不同的图）的块的图形数据。这种方法不实用，因为数据集几乎总是显着大于32000点。

我希望宏做的是自动绘制并标记每8000个数据点，直到没有更多数据可供图表。

我一直在研究使用循环，但我不熟悉编写代码而不确定如何。

非常感谢任何建议或帮助！

以下是我的一些批处理代码：

'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

Answer 1

这是我想出的。

宏计算已使用的行总数，然后将该数字除以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

Answer 2

听起来您已经了解如何为给定的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

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

2 个答案: