Разделить данные в разные столбцы

Question

Я работаю над таблицей CSV Excel и столкнулся с проблемой с макросом VBA.

Мой оригинальный файл CSV выглядит следующим образом:

То, что я пытаюсь сделать, просто, я хотел бы обнаружить, когда есть разные опции в «Option1Name», и разделить данные (Имя + Значение) в следующем столбце.

Вот окончательный результат:

Когда я выполняю свой макрос, он перемещает данные в другой столбец, но только в первый ряд:

Вот мой код:

Sub fillHandle()
Dim i As Long
Dim optStart As Integer

'Start counting the option
 optStart = 2

 For i = 2 To 6000

 Column2 = Sheets("products").Range("I" & i).Value

 If IsEmpty(Range("H" & i)) = False Then

    If optStart <> 2 Then
        If Sheets("products").Range("I" & i - 1).Value <> Column2 Then
            Sheets("products").Range("J" & i).Value = Sheets("products").Range("H" & i).Value
            Sheets("products").Range("K" & i).Value = Column2
            Sheets("products").Range("H" & i).Value = ""
            Sheets("products").Range("I" & i).Value = ""
        End If
    End If
Else
'If option cell is blank then we set the i variable with the row of the column
optStart = i
End If

Next i

End Sub

Answer 1

я наконец-то преуспел, даже если предположил, что мой код можно улучшить:

Sub splitColumn()
Dim i As Long
Dim optStart As Integer
Dim OptionRowName As Integer
Dim OptionRowValue As Integer

'Start counting the option
optStart = 2
OptionRowName = 3
OptionRowValue = 4

For i = 2 To 6000

'Retrieving option Value
Column2 = Sheets("products - Copie").Range("B" & i).Value

'If Option Name is not empty
If IsEmpty(Range("A" & i)) = False Then
    'If it is not the first time we loop (we don't want to move the first option of the first line)
    If i <> 2 Then
        'If Column2 and Active cell do not contains the same datas
        If Sheets("products - Copie").Range("B" & i - 1).Value <> Column2 Then
            'I'm starting to move the datas in the next columns
            Sheets("products - Copie").Range(Split(Cells(1, OptionRowName).Address, "$")(1) & optStart).Value = Sheets("products - Copie").Range("A" & i).Value
            Sheets("products - Copie").Range(Split(Cells(1, OptionRowValue).Address, "$")(1) & optStart).Value = Column2
            'Then I delete the obsolete values
            Sheets("products - Copie").Range(Split(Cells(1, 1).Address, "$")(1) & i).Value = ""
            Sheets("products - Copie").Range(Split(Cells(1, 2).Address, "$")(1) & i).Value = ""
            optStart = optStart + 1
            OptionRowName = OptionRowName + 2
        End If
    End If
Else
    'If option Name and Option Value are empty cells, it means it is a new product
    If IsEmpty(Range("A" & i)) = False And IsEmpty(Range("B" & i)) = False Then
        optStart = i
    End If

    'If Option value cell is not empty and It is not the first time we loop into, it means it is a new
    'option to move
    If IsEmpty(Range("B" & i)) = False And optStart <> 2 Then
        'I'm starting to move the datas in the next columns
        Sheets("products - Copie").Range(Split(Cells(1, OptionRowValue).Address, "$")(1) & optStart).Value = Column2
        Sheets("products - Copie").Range(Split(Cells(1, 2).Address, "$")(1) & i).Value = ""
        'We decrement optStart to place the data in the right cell at next round
        optStart = optStart - 1
        OptionRowValue = OptionRowValue + 2

    End If
End If

Next i

End Sub