Вставка строки на основе длины строки в ячейке

Question

Как мог я вставить строку на основе значения строк, например, у меня есть следующие случаи в клетках

SFF465 
SFF465+466 
SFF466+467+468+469 
SFF469+DFG234 
DFG235 
DFG236+237+238+239 

Если есть или более значений в в той же ячейке я хочу вставить новую строку для второй партии. Например, в первой строке не должно быть никаких изменений, но во второй строке обе партии должны разделяться в разных строках. Мне нужно SFF465 во второй строке и SFF 466 в третьей строке. Таким образом, вторая строка будет изменяться только с SFF465+466 до SFF465.

То же самое относится и к текущей третьей строки, которая имеет четыре номера и хотят разделить их по отдельности, как SFF466, SFF467, SFF468, SFF469 ниже текущей строки.

В четвертой строке вы можете увидеть два разных продукта. Я хочу разделить их, добавив еще одну строку ниже текущей четвертой строки. Следовательно, преобразование тока четвертой строки в SFF469 и пятой строке, как DFG234.

Желаемый формат будет

SFF465 
SFF465 
SFF466 
SFF466 
SFF467 
SFF468 
SFF469 
SFF469 
DFG234 
DFG235 
DFG236 
DFG237 
DFG238 
DFG239 

Спасибо заранее.

Я написал код, используя относительные ссылки и модифицируя их, используя If Then и Do While.

Sub Vcpy() 
' ' Vcpy Macro 

    If ActiveCell.Value <> Empty Then 

     Do While ActiveCell.Value <> Empty 

     ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove  
     ActiveCell.Offset(-1, 4).Range("A1").Select 
     Selection.Copy 
     ActiveCell.Offset(1, -1).Range("A1").Select 
     ActiveSheet.Paste Application.CutCopyMode = False 
     ActiveCell.Offset(1, 1).Range("A1").Select 

     Loop 

    End If 

End Sub 

Answer 1

Я понятия не имею, как заставить ваш код работать, но у меня другое решение. Проверено в вашем примере набора данных.

Sub RowSplitter() 
    Dim rng As Range 
    Dim arr() As String 
    Dim str As String 

    Set rng = Range("A1") 

    Do While (rng.Value <> "") 
     ' Determine if we need to split 
     If Len(rng.Value) > 6 Then 
      ' Split values into an array 
      arr() = Split(rng.Value, "+") 

      For i = 1 To UBound(arr()) 
       str = "" 

       ' Insert row 
       rng.Offset(i).Insert Shift:=xlDown 

       ' Calculate string to insert from array 
       If Len(arr(i)) < 4 Then str = Left(arr(0), 3) 
       str = str & arr(i) 

       ' Enter value from array 
       rng.Offset(i).Value = str 
      Next i 

      rng.Value = arr(0) 
     End If 

     Set rng = rng.Offset(1) 
    Loop 
End Sub