VBA将单元格内容设置为命名范围名称

我试图设置范围中的第一个单元格的前7个字符作为命名的范围名称，如果单元格以单词“kit”开头。

这是我到目前为止：

Sub DefineRanges() Dim rngStart As Range Set rngStart = Range("A1") Dim LastRow As Integer Dim RangeName As String For Each cell In Range("A2:A7") If LCase(Left(cell.Value, 3)) = "kit" Then RangeName = LCase(Left(cell.Value, 7)) ActiveWorkbook.Names.Add _ Name:=RangeName, _ RefersToLocal:=Range(rngStart.Address & ":C" & cell.Row - 1) Set rngStart = Range("A" & cell.Row) End If LastRow = cell.Row Next RangeName = LCase(Left(cell.Value, 7)) ActiveWorkbook.Names.Add _ Name:=RangeName, _ RefersToLocal:=Range(rngStart.Address & ":C" & LastRow) End Sub 

本质上，我希望它能够查看整个范围，find任何以单词“kit”开头的单元格，创build一个从该单元格开始直到以“kit”开头的下一个单元格的命名范围，并指定前7个字符该单元格是范围名称。 到目前为止，我能够得到它来创build范围，但当我尝试将单元格的内容传递给范围名称时遇到问题。 有任何想法吗？

Answer 1

这假定你的数据与你最后一个问题类似。

它使用Match来查找每个"Kit..."节省几个迭代：

 Sub DefineRanges() Dim rngStart As Long Dim RangeName As String Dim col As Long Dim PreFx As String col = 1 'change to the column number you need PreFx = "kat" 'change to the prefix you are looking for With Worksheets("Sheet7") 'change to your sheet On Error Resume Next rngStart = Application.WorksheetFunction.Match(PreFx & "*", .Columns(col), 0) On Error GoTo 0 If rngStart > 0 Then Do i = 0 On Error Resume Next i = Application.WorksheetFunction.Match(PreFx & "*", .Range(.Cells(rngStart + 1, col), .Cells(.Rows.Count, col)), 0) + rngStart On Error GoTo 0 If i > 0 Then RangeName = LCase(Left(.Cells(rngStart, col).Value, 7)) ActiveWorkbook.names.Add name:=RangeName, RefersToLocal:=.Range(.Cells(rngStart, col), .Cells(i - 1, col + 2)) rngStart = i Else 'no more "kit..." so find the last row with data and use that i = Application.WorksheetFunction.Match("zzz", .Columns(col)) RangeName = LCase(Left(.Cells(rngStart, 1).Value, 7)) ActiveWorkbook.names.Add name:=RangeName, RefersToLocal:=.Range(.Cells(rngStart, col), .Cells(i - 1, col + 2)) End If Loop While i < Application.WorksheetFunction.Match("zzz", .Columns(col)) End If End With End Sub