Excel VBA如何自动识别同行列含Dashboard的列并生成命名范围

完整修改后代码 #

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 foundCell As Range
Dim firstFoundCol As Long
Dim ColumnList As String ' 从常量改为动态拼接的变量

Dim myNamedRange As Range
Dim myRangeName As String

Set ws = ThisWorkbook.Sheets("Data_Range")
lnRow = 3

' 遍历第3行所有包含Dashboard的单元格
With ws.Rows(lnRow)
    Set foundCell = .Find(What:="Dashboard", LookIn:=xlValues, LookAt:=xlWhole, _
        SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
    ' 无匹配列直接退出避免报错
    If foundCell Is Nothing Then
        MsgBox "第3行未找到包含Dashboard的列，程序退出"
        Exit Sub
    End If
    ' 记录首个匹配列位置，作为循环终止判断条件
    firstFoundCol = foundCell.Column
    ' 提取首个匹配列的列标
    ColumnList = Split(foundCell.Address, "$")(1)
    ' 循环查找后续所有匹配列
    Do
        Set foundCell = .FindNext(foundCell)
        If foundCell.Column = firstFoundCol Then Exit Do
        ' 拼接新匹配列的列标
        ColumnList = ColumnList & "," & Split(foundCell.Address, "$")(1)
    Loop
End With

' 统一用目标工作表计算最后一行，避免ActiveSheet取值错误
With ws
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

' 行起始位置配置
Const StartAtRow As Long = 8

' 拆分列列表为数组
arrColumns = Split(ColumnList, ",")

' 拼接第一个列的范围字符串
strSelect = arrColumns(0) & StartAtRow & ":" & arrColumns(0) & lastRow

' 拼接剩余列的范围字符串
For i = 1 To UBound(arrColumns)
    strSelect = strSelect & "," & arrColumns(i) & StartAtRow & ":" & arrColumns(i) & lastRow
Next i

' 生成命名范围
Set myNamedRange = ws.Range(strSelect)
myRangeName = "Dashboard_Data"
ThisWorkbook.Names.Add Name:=myRangeName, RefersTo:=myNamedRange

End Sub

核心修改说明 #

• 替换原单次Find逻辑：调用Find定位首个匹配单元格后，循环调用FindNext收集所有符合条件的列，直到回到首个匹配位置结束循环，避免漏查
• 动态生成列列表：从匹配单元格地址中自动提取列标，拼接为C,E,H,O格式的列表，完全替代硬编码配置
• 修复行数计算逻辑：统一绑定Data_Range工作表计算最后一行，避免当前激活工作表不是目标表时的取值错误
• 新增异常处理：未找到任何匹配列时弹出提示直接退出，避免后续代码执行报错

内容的提问来源于stack exchange，提问作者H BG