Insérer des lignes VBA

Question

À l'heure actuelle, j'ai un classeur maître Excel que les employés utilisent pour la saisie de données. Chacun d'entre eux télécharge une copie sur leur bureau et marque ensuite leur progression sur diverses entrées en saisissant un "x" dans une ligne à côté des données qu'ils ont terminées. Chaque produit a sa propre ligne avec ses données respectives répertoriées sur cette ligne. Le classeur principal est rempli tout au long du trimestre avec de nouvelles données pour les produits dès qu'elles sont disponibles, qui sont actuellement mises à jour sur chaque classeur individuel en utilisant une macro qui copie simplement la plage où se trouvent les données (voir le code ci-dessous).

Sub GetDataFromClosedWorkbook() 
'Created by XXXX 5/2/2014 
Application.ScreenUpdating = False ' turn off the screen updating 

Dim wb As Workbook 
Set wb = Workbooks.Open("LOCATION OF FILE", True, True) 
' open the source workbook, read only 
With ThisWorkbook.Worksheets("1") 
' read data from the source workbook: (Left of (=) is paste @ destination, right of it is copy) 
.Range("F8:K25").Value = wb.Worksheets("1").Range("F8:K25").Value 
End With 

With ThisWorkbook.Worksheets("2") 
' read data from the source workbook: (Left of (=) is paste @ destination, right of it is copy) 
.Range("V5:Z359").Value = wb.Worksheets("2").Range("V5:Z359").Value 
End With 

wb.Close False ' close the source workbook without saving any changes 
Set wb = Nothing ' free memory 
Application.ScreenUpdating = True ' turn on the screen updating 

End Sub 

Le problème que je vais avoir est la suivante: chaque fois un certain temps, je vais avoir besoin d'ajouter un nouveau produit, qui ajoute une ligne sur le maître (ce qui est opposé à l'ajout de données, ce qui est juste ajouté à travers la rangée). Parfois, cette rangée est à la fin, parfois c'est au milieu. Comme vous pouvez le voir dans le code ci-dessous, mon VBA ne peut actuellement pas gérer ce changement de ligne car il s'agit simplement de copier/coller à partir d'une plage prédéfinie. Le classeur de chaque utilisateur ne détecte pas ce changement dans la ligne # et les données dans les colonnes sont donc associées aux mauvaises lignes. Normalement, vous pouvez simplement copier la feuille entière et le problème résolu. Le problème que j'ai, c'est que chaque utilisateur doit être en mesure d'enregistrer leur propre processus dans leur propre classeur à côté de leurs données. Existe-t-il un moyen de coder ceci afin qu'une nouvelle ligne sur la feuille principale soit prise en compte et ajoutée à toutes les autres sans effacer/déplacer les marques faites par chaque utilisateur? J'ai essayé de trouver un moyen de "insérer" des lignes si elles sont nouvelles dans le maître, car cela permettrait de préserver les données, mais ne peut pas le comprendre. En outre, en raison de la sécurité sur le serveur au work-linking classeurs, etc n'est pas une option. Quelqu'un at-il des idées à ce sujet?

Answer 1

Une façon d'aborder ce problème consiste à utiliser l'objet Scripting.Dictionary. Vous pouvez créer un dictionnaire pour les identificateurs cible et source et les comparer. Je suppose que vous n'avez pas vraiment besoin de la paire clé-valeur pour y parvenir, mais j'espère que cela vous met sur la bonne voie!

Sub Main() 

Dim source As Worksheet 
Dim target As Worksheet 
Dim dictSource As Object 
Dim dictTarget As Object 
Dim rng As Range 
Dim i As Integer 
Dim j As Integer 
Dim idSource As String 
Dim idTarget As String 
Dim offset As Integer 

Set source = ThisWorkbook.Sheets(2) 
Set target = ThisWorkbook.Sheets(1) 

offset = 9 'My data starts at row 10, so the offset will be 9 

Set rng = source.Range("A10:A" & source.Cells(source.Rows.Count, "A").End(xlUp).Row) 
Set dictSource = CreateObject("Scripting.Dictionary") 
For Each cell In rng 
    dictSource.Add Key:=cell.Value, Item:=cell.Row 
Next 

Set rng = target.Range("A10:A" & target.Cells(target.Rows.Count, "A").End(xlUp).Row) 
Set dictTarget = CreateObject("Scripting.Dictionary") 
For Each cell In rng 
    dictTarget.Add Key:=cell.Value, Item:=cell.Row 
Next 

i = 1 
j = source.Range("A10:A" & source.Cells(source.Rows.Count, "A").End(xlUp).Row).Rows.Count 
Do While i <= j 
Retry: 
    idSource = source.Cells(i + offset, 1).Value 
    idTarget = target.Cells(i + offset, 1).Value 
    If Not (dictSource.Exists(idTarget)) And idTarget <> "" Then 
     'Delete unwanted rows 
     target.Cells(i + offset, 1).EntireRow.Delete 
     GoTo Retry 
    End If 
    If dictTarget.Exists(idSource) Then 
     'The identifier was found so we can update the values here... 
     dictTarget.Remove (idSource) 
    ElseIf idSource <> "" Then 
     'The identifier wasn't found so we can insert a row 
     target.Cells(i + offset, 1).EntireRow.Insert 
     'And you're ready to copy the values over 
     target.Cells(i + offset, 1).Value = idSource 
    End If 
    i = i + 1 
Loop 

Set dictSource = Nothing 
Set dictTarget = Nothing 

End Sub