Создание нескольких графиков из большого набора данных с помощью цикла VBA
Я пытаюсь создать макрос в VBA, который возьмет большой набор данных в Sheet1 (так называемые необработанные данные) и создаст точечную диаграмму XY для каждых 8000 точек данных на другом листе. Макрос также должен будет помечать каждый график тем диапазоном, который он представляет (например, 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
2 ответов:
Вот что я придумал.
Макрос вычисляет общее число используемых строк, а затем делит это число на 8000.За...Следующий цикл выполняется от 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
Похоже, вы уже знаете, как создавать диаграммы для заданных 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
Comments