VBA方法excel根据值将单元格移动到其他行

Question

我正在努力使用excel中的VBA方法.我有一个需要根据产品类别进行编辑的CSV.

csv看起来像这样:

我想要实现的结果是:

这是我写的方法; 我想我很接近,但它还没有按照预期工作.

Sub test()
    'c is a CELL or a range
    Dim c As Range

    'for each CELL in this range
    For Each c In Range("A2", Cells(Cells.SpecialCells(xlCellTypeLastCell).Row, 1))

        'Als de cel leeg is en de volgende niet dan
        If c = "" And c.Offset(1, 0) <> "" Then
            'verplaats inhoud lege cel naar 1 boven
            c.Offset(-1, 6) = c.Offset(0, 5)
            'Verwijder rij
            c.EntireRow.Delete       

        'Als de cel leeg is en de volgende ook dan
        ElseIf c = "" And c.Offset(1, 0) = "" Then
            'verplaats inhoud lege cel naar 1 boven
            If c.Offset(0, 5) <> "" Then
                c.Offset(-1, 6) = c.Offset(0, 5)

            'Als inhoud
            ElseIf c.Offset(1, 5) <> "" Then
                c.Offset(-1, 7) = c.Offset(1, 5)

            Else
                c.EntireRow.Delete
                c.Offset(1,0).EntireRow.Delete    
            End If

        End If
    Next
End Sub

CSV中有一些行是完全空的,所以这也需要考虑.

Answer 1

我将循环遍历行并检查每个条目下面的两行是否已填充，然后将条目的值设置为最后填充的值。然后，您可以拆分该值以将这些值放入多列中。

提示：当循环单元格并删除行时，您总是希望从底部开始一直到顶部。

尝试这个：

Sub test()

Dim arr() as String
Dim x As Long, i as long, lRow as long

With ThisWorkbook.Sheets("SheetName")
    lRow = .Cells(.Rows.Count, 1).End(xlUp).Row

    'Insert 2 columns to hold the extra information
    .Columns("E:F").Insert

    For x = lRow to 2 Step -1

        'Delete rows that are completely blank
        If .Cells(x, "A").Value = "" And .Cells(x, "D").Value = "" Then
            .Cells(x, "A").EntireRow.Delete

        'Find the next entry
        ElseIf .Cells(x, "A").Value <> "" Then

            'Check if the 2nd row below the entry is populated
            If .Cells(x + 2, "A").Value = "" And .Cells(x + 2, "D").Value <> "" Then
                .Cells(x, "D").Value = .Cells(x + 2, "D").Value
                .Range(.Cells(x + 2, "D"), .Cells(x + 1, "D")).EntireRow.Delete

                'Split the strings using the "/" character, if there is also a space you will need to use "/ " instead, then populate the inserted columns
                arr = Split(.Cells(x, "D").Value, "/")
                For i = 0 to UBound(arr)
                    .Cells(x, 4 + i).Value = arr(i)
                Next i

            'If the 2nd row isn't populated only take the row below
            ElseIf .Cells(x + 1, "A").Value = "" And .Cells(x + 1, "D").Value <> "" Then
                .Cells(x, "D").Value = .Cells(x + 1, "D").Value
                .Cells(x + 1, "D").EntireRow.Delete

                'Split the strings using the "/" character, if there is also a space you will need to use "/ " instead, then populate the inserted columns
                arr = Split(.Cells(x, "D").Value, "/")
                For i = 0 to UBound(arr)
                    .Cells(x, 4 + i).Value = arr(i)
                Next i

            End If

        End If

    Next x

End With

End Sub