根据值移动单元格

对于excel来说，我对于VBA非常有帮助。 我有一个产品表，产品可以有多个类别。 链接到产品的类别可以包含子类别，它们位于其旁边的列中。 如果产品有多个类别，则这些类别位于产品下方一行。 见图1。

我想要实现的是：每次执行脚本时，产品信息行上的当前类别都需要用它下面的类别replace，直到到达下一个产品。 如果没有新的类别可replace，则产品行可以被删除。 （在这个例子中，我需要运行脚本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 (ie 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