我正在撰寫一個代碼，該代碼基于一組不同的列定義一個命名范圍。這些列通過在同一行中寫有“儀表板”一詞來標識。
如果我指定了確切的列（參見下面的“C、E、H、O”），代碼現在可以作業，但我不知道如何讓代碼收集所有匹配的列，然后從中創建 ColumnList。
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) & StartAtRow
' and add rows to last ne found above
strSelect = strSelect & ":" & arrColumns(0) & lastRow
' Add rest of columns to selection list
For i = 1 To UBound(arrColumns)
strSelect = strSelect & "," & arrColumns(i) & StartAtRow & ":" & arrColumns(i) & 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
uj5u.com熱心網友回復：
您可以使用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
轉載請註明出處，本文鏈接：https://www.uj5u.com/qiye/371425.html