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 

は基本的に私はそれは、私の全体の範囲に目を通すの単語「キット」で始まる任意の細胞を見つけ、それから行く名前付き範囲を作成したいですセルを「キット」で始まる次のセルまで移動し、そのセルの最初の7文字を範囲名に割り当てます。これまでは範囲を作成することができましたが、セルの内容を範囲名に渡そうとすると問題が発生します。何か案は？

Answer 1

これは、あなたのデータがあなたの最後の質問と似ていることを前提としています。

これは、各"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