値に基づいてセルを移動

Question

私はExcelのためにVBAで苦労しています。私は、製品が複数のカテゴリを持つことができる製品を備えたテーブルを持っています。製品にリンクされているカテゴリには、そのカテゴリの横の列にあるサブカテゴリがあります。製品に複数のカテゴリがある場合、これらのカテゴリは製品の1行下に配置されます。 pic1を参照してください。

私が達成したい何

： 私はスクリプトを実行するたびに到達するまで、製品情報の行にある現在のカテゴリが、その下のカテゴリーで交換する必要があります次の製品。交換する新しいカテゴリがない場合は、製品行を削除することができます。 （この例では、スクリプトを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