根据值向上移动单元格

Question

我有点在使用 VBA for excel 苦苦挣扎。我有一张产品表，其中产品可以有多个类别。链接到产品的类别可以具有子类别，这些子类别位于其旁边的列中。如果产品有多个类别，则这些类别位于产品下方的一行。见图1。

我想要达到的目标： 每次执行脚本时，产品信息行上的当前类别都需要替换为其下面的类别，直到您到达下一个产品。如果没有要替换的新类别，可以删除产品行。 （在这个例子中，我需要运行脚本 3 次）。所以我最终会得到这个：

第一次运行脚本：

第二次运行脚本：

第三次运行脚本：

到目前为止我得到的代码是：

Sub MoveEmpty()

Dim i as Long, j as Long

Application.ScreenUpdating = False
j = Range("A" & Rows.Count).End(xlUp).Row
For i = j to 3 Step -1
    If Range("A" & i) <> "" Then  
       Range("C" & i -1) = Range("C" & i).Resize(,3)
       Range("A" & i).EntireRow.Delete
    End If
Next i


End Sub

希望这是有道理的，感谢您的帮助，

巴特

Answer 1

你在正确的轨道上，这应该做你想做的事：

Sub MoveEmpty()

Dim i As Long, j As Long
Dim ws As Worksheet

Application.ScreenUpdating = False

' Set this appropriately
Set ws = ThisWorkbook.Worksheets("MyWorksheet")

j = ws.Range("A" & Rows.Count).End(xlUp).Row
For i = j To 3 Step -1
    If ws.Range("A" & i) <> "" Then
        ' Copy the product name to be next to the 2nd category set down, if there is a category
        If ws.Range("A" & (i + 1)) = "" And ws.Range("C" & (i + 1)) <> "" Then
            ' If you just want the values (i.e. no formatting copied)
            ws.Range("A" & (i + 1)).Resize(, 2).Value = ws.Range("A" & i).Resize(, 2).Value
            ' If you want everything, including formats
            Call ws.Range("A" & i).Resize(, 2).Copy(ws.Range("A" & (i + 1)).Resize(, 2))
        End If

        ws.Range("A" & i).EntireRow.Delete
    End If
Next i
' Reset the screen to updating
Application.ScreenUpdating = True

End Sub