셀 내용을 명명 된 범위 이름으로 설정하는 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