Скажите цикл, чтобы вставить только одну ячейку и не полностью вниз

Я пытаюсь сделать цикл, который пройдет через этот набор данных.

введите описание изображения здесь

Вот как должен выглядеть вывод.

введите описание изображения здесь

Я все еще получаю завивки циклов, но это то, что у меня есть до сих пор:

Private Sub CommandButton1_Click() Dim i As Long, j As Long, k As Byte, iLines As Long j = 1 For i = 1 To 25 For k = 1 To 8 If k = 1 Then Cells(j, 10).Value = Len(Cells((j + 2), 1).Value) - Len(Replace(Cells((j + 2), 1).Value, ",", "")) + 1 Cells(i, 11).Value = "SET" Cells(i, 12).Value = Cells(i, 1).Value End If Next k Next i End Sub 

На данный момент моя проблема связана с моим контуром. Он учитывает только запятые в первом наборе данных, а не в других. Также там, где он выводит SET, он копирует, а не просто помещает его в одну ячейку. Смотри ниже.

введите описание изображения здесь

У меня, вероятно, будет больше вопросов, поскольку я продвигаюсь вперед. Заранее спасибо за помощь!

Попробуй это:

По возможности избавляйтесь от цикла. Я заменил его находкой, чтобы найти следующую ячейку с «HW» в ней. Он автоматически перейдет от одного «HW» к следующему.

При использовании шагов привязывайте все в одной строке и расширяйте выделение с помощью изменения размера.

 Private Sub CommandButton1_Click() Dim ws As Worksheet Dim i As Long Dim k As Long Set ws = ActiveSheet With ws For i = 1 To 200 If Left(.Cells(i, 1).Value, 2) = "HW" Then On Error Resume Next k = .Range(.Cells(i + 1, 1), .Cells(200, 1)).Find("HW").Row On Error GoTo 0 If k <= i Then k = 200 .Cells(i, 10).Value = Len(Cells((i + 2), 1).Value) - Len(Replace(Cells((i + 2), 1).Value, ",", "")) + 1 .Cells(i, 11).Value = "SET" .Cells(i, 12).Resize(k - i).Value = .Cells(i, 1).Resize(k - i).Value i = k - 1 End If Next i End With End Sub 
Interesting Posts
Давайте будем гением компьютера.