VBA zum Festlegen der Zelleninhalte als Name des benannten Bereichs

Question

Ich versuche, die ersten 7 Zeichen der ersten Zelle in einem Bereich als Name eines benannten Bereichs festzulegen, wenn die Zelle mit dem Wort "kit" beginnt.

Hier ist, was ich bisher:

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 

Grunde möchte ich es durch meine gesamte Strecke zu sehen, alle Zellen finden, die mit dem Wort „Kit“ beginnen, erstellen Sie einen benannten Bereich, die von diesem geht Zelle bis zur nächsten Zelle, die mit "kit" beginnt, und weisen Sie die ersten 7 Zeichen der Zelle dem Namen der Bereiche zu. Bisher bin ich in der Lage, die Bereiche zu erstellen, aber ich stoße auf Probleme, wenn ich versuche, den Inhalt der Zelle in den Bereichsnamen zu übernehmen. Irgendwelche Ideen?

Answer 1

Dies setzt voraus, dass Ihre Daten Ihrer letzten Frage ähnlich sind.

Es nutzt Spiel jeweils "Kit..." Speichern ein paar Iterationen zu finden:

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