Блог

Я пишу код, который определяет именованный диапазон на основе другого набора столбцов. Эти столбцы идентифицируются тем, что все они имеют слово «Панель мониторинга», написанное в одной строке.

Код работает прямо сейчас,если я укажу точные столбцы (см. Ниже «C,E,H, O»), но я не понимаю, как заставить код собрать все соответствующие столбцы, а затем создать из них список столбцов.

 Option Explicit  Sub Define_Chart_Range()  Dim ws As Worksheet Dim lastRow As Long Dim arrColumns As Variant Dim strSelect As String Dim i As Integer Dim lnRow As Long, lnCol As Long  Dim myNamedRange As Range Dim myRangeName As String  Set ws = ThisWorkbook.Sheets("Data_Range")  'finding all columns that have the word Dashboard in Row 3 lnRow = 3 lnCol = ws.Cells(lnRow, 1).EntireRow.Find(What:="Dashboard", _ LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, _ SearchDirection:=xlNext, MatchCase:=False).Column   'Find the last used row in Column A With ActiveSheet  lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row End With  ' Describe what columns you want to select Const ColumnList As String = "C,E,H,O"  ' Row to start at Const StartAtRow As Long = 8  ' Create an array to hold columns arrColumns = Split(ColumnList, ",")   ' Define first column to select strSelect = arrColumns(0) amp; StartAtRow ' and add rows to last ne found above strSelect = strSelect amp; ":" amp; arrColumns(0) amp; lastRow  ' Add rest of columns to selection list For i = 1 To UBound(arrColumns)  strSelect = strSelect amp; "," amp; arrColumns(i) amp; StartAtRow amp; ":" amp; arrColumns(i) amp; lastRow Next i  ' Defining name of Selected Columns as Named Range Set ws = ThisWorkbook.Worksheets("Data_Range") Set myNamedRange = ws.Range(strSelect)  'specify defined name myRangeName = "Dashboard_Data"  'create named range with workbook scope. Defined name and cell range are as specified ThisWorkbook.Names.Add Name:=myRangeName, RefersTo:=myNamedRange   End Sub  

Вы можете использовать Union для непосредственного построения диапазона, без необходимости работать с адресами диапазона.

 Sub Define_Chart_Range()   Const SearchRow As Long = 3  Const StartAtRow As Long = 8  Const RangeName As String = "Dashboard_Data"    Dim ws As Worksheet, lastRow As Long  Dim myNamedRange As Range, rng As Range, c As Range  Dim myRangeName As String   Set ws = ThisWorkbook.Sheets("Data_Range")  lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row  'loop cells in row to search...  For Each c In ws.Range(ws.Cells(SearchRow, 1), _  ws.Cells(SearchRow, Columns.Count).End(xlToLeft)).Cells  If LCase(c.Value) = "dashboard" Then 'want this column  'add to range  BuildRange myNamedRange, _  ws.Range(ws.Cells(StartAtRow, c.Column), ws.Cells(lastRow, c.Column))    End If  Next c    Debug.Print myNamedRange.Address  ThisWorkbook.Names.Add Name:=RangeName, RefersTo:=myNamedRange  End Sub  'utility sub to build up a range using Application.Union Sub BuildRange(ByRef rngTot As Range, rngAdd As Range)  If rngTot Is Nothing Then  Set rngTot = rngAdd  Else  Set rngTot = Application.Union(rngTot, rngAdd)  End If End Sub