Déplacer les cellules en fonction de la valeur

Question

Je suis un peu difficile avec VBA pour Excel. J'ai une table avec des produits, où les produits peuvent avoir plusieurs catégories. Les catégories associées à un produit peuvent comporter des sous-catégories, situées dans les colonnes adjacentes. Si un produit comporte plusieurs catégories, ces catégories sont situées une seule ligne sous le produit. Voir pic1.

Ce que je veux atteindre: Chaque fois que j'exécute le script, les catégories actuelles qui sont sur la ligne de l'information produit doivent être remplacées par les catégories ci-dessous, jusqu'à ce que vous atteigniez le prochain produit. S'il n'y a pas de nouvelle catégorie à remplacer, la ligne de produit peut être supprimée. (Dans cet exemple, j'ai besoin d'exécuter le script 3 fois). Donc, je finira par se retrouver avec ceci:

Exécuter le script première fois:

script Run deuxième fois:

script Run 3ème fois:

Le code I » Je suis si loin est:

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 

Hope this sens, et merci pour aider,

Bart

Answer 1

Vous étiez sur la bonne voie, cela devrait faire ce que vous voulez:

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