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

Question

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

这是我到目前为止所拥有的：

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

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

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