基于值移动单元格

Question

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

我想达到的目标： 我每次执行脚本，需要当前类别是对产品信息的行与它下面的类别进行更换，直到你到达下一个产品。如果没有新的类别可替换，则产品行可以被删除。 （在这个例子中，我需要运行脚本3次）。所以，我最终会落得这样的：

运行脚本第一次：

运行脚本第二次：

运行脚本第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