将数据拆分到不同的列中

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