Блог

Я пытаюсь создать графики каждого столбца данных на листе. На данный момент он работает до тех пор, пока в столбце данных нет пробелов, но мне нужно, чтобы он был достаточно надежным, чтобы он работал, если в данных есть пробелы. Данные вводятся пакетами с различными столбцами разной длины из-за различных требований к измерениям. Каждая из строк также будет иметь идентификатор в первом столбце, указывающий, из какого пакета данных взята эта строка (см. Прикрепленный файл). Поскольку столбец идентификатора будет иметь ту же длину, что и самый длинный столбец данных, я сравниваю последнюю строку этого столбца с нижней строкой любого данного столбца данных, чтобы убедиться, что все данные отображаются на графике. Однако прямо сейчас он застревает в цикле, если в данных есть пробел.

 Sub GraphAllColumns()  Dim col As Range 'The cell at the top of the data column  Dim bottomRow As Range  Dim bottomData As Range    Set col = ActiveSheet.Range("B7")  Set bottomRow = Range("A7").End(xlDown)    col.Select    If Not IsEmpty(Selection) Then 'If the worksheet is empty, nothing happens  Do  Set bottomData = Selection.End(xlDown)  If bottomRow.Row lt;= bottomData.Row Then  'Iterate through every column, select all the data in that column  'then call the create graph subroutine  Call CreateGraph  ActiveCell.Offset(0, 1).Select  Else  If IsEmpty(Selection.End(xlDown)) Then  Call CreateGraph  ActiveCell.Offset(0, 1).Select  Else  Range(Selection, Selection.End(xlDown)).Select  End If  End If  Loop Until IsEmpty(Selection)  End If   End Sub  Here's the CreateGraph subroutine as well. I'm happy the way that it works. I know it isn't the best way, but this is my first time using VBA.   Sub CreateGraph()  Dim startCell As Range 'Starting cell (important for column selection)  Dim graphRange As Range    Set startCell = Selection  Set graphRange = Range(startCell, startCell.End(xlDown)) 'Selects all data in column    'Create chart, define chart type and source data  ActiveSheet.Shapes.AddChart.Select  ActiveChart.ChartType = xlLine  ActiveChart.SetSourceData Source:=graphRange    'Change chart location so that all charts on a sheet are stacked in top left corner  With ActiveChart.Parent  .Top = Range("A1")  .Left = Range("A1")  End With    'Change chart title and other attributes  With ActiveChart  .HasTitle = True  .ChartTitle.Text = startCell.Offset(-2, 0).Value    End With  End Sub  

Возможно, я все еще неправильно понимаю, чего вы хотите, но это должно помочь вам начать.

 Sub PlotDataById()    Dim dict As Object, id, ws As Worksheet, rngId As Range    Set ws = ActiveSheet 'or whatever    Set dict = IdRanges(ws.Range("B3")) 'get the ranges for each id    For Each id In dict  Set rngId = dict(id).Offset(0, 1) 'first set of data  Debug.Print "Plotting id - " amp; id amp; ":" amp; rngId.Address  Do While Application.CountA(rngId) gt; 0  'use resize() to pass only the occupied range  CreateGraph rngId.Resize(Application.CountA(rngId)), id  Set rngId = rngId.Offset(0, 1) 'next column over  Loop  Next id   End Sub  'Capture the ranges occupied by each id in a list, starting at `startCell` ' Assumes list is sorted by id Function IdRanges(startCell As Range) As Object  Dim c As Range, id, currId, cStart As Range, dict As Object  Set dict = CreateObject("scripting.dictionary")    currId = Chr(0) 'some non-value  Set c = startCell  Do While Len(c.Value) gt; 0  id = c.Value  If id lt;gt; currId Then  If Not cStart Is Nothing Then  dict.Add currId, c.Parent.Range(cStart, c.Offset(-1, 0))  End If  Set cStart = c  currId = id  End If  Set c = c.Offset(1, 0)  Loop  dict.Add currId, c.Parent.Range(cStart, c.Offset(-1, 0))  Set IdRanges = dict End Function  'Create a plot of `rngData` with title `chtTitle` Sub CreateGraph(rngData As Range, chtTitle)  Dim co As Shape, cht As Chart, ws As Worksheet  Set ws = rngData.Parent  Set co = ws.Shapes.AddChart  With co.Chart  .ChartType = xlLine  .SetSourceData Source:=rngData  .HasTitle = True  .ChartTitle.Text = chtTitle  End With  With co 'all charts on a sheet are stacked in top left corner  .Top = ws.Range("A1").Top  .Left = ws.Range("A1").Left  End With End Sub  

Использование Select/ActiveCell-не очень надежный способ структурирования кода, и, как правило, вы можете избежать почти всех применений этого подхода.