基於值移動單元格

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