插入行VBA

Question

现在我有一个员工用于数据输入的主Excel工作簿。他们每个人都将一份副本下载到他们的桌面上，然后通过在他们完成的数据旁边的comlun中输入“x”来标记他们在各种条目上的进度。每个产品都有自己的行，并在该行中列出各自的数据。在本季度，主工作簿会在产品可用时添加新数据，该数据目前已通过使用仅复制数据范围（请参阅下面的代码）的宏在每个个人工作簿中更新。

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 

我遇到的问题是这样的：每过一段时间，我需要添加一个新的产品，它增加了主服务器上的行（这是反对添加数据，这仅仅是横跨行添加）。有时候，这一行最后，有时是在中间。正如你从下面的代码可以看到的，我的VBA目前无法处理这一行更改，因为它只是从预定义的范围复制/粘贴。每个用户的工作簿都不会在行＃中发生此更改，因此列中的数据与错误的行关联。通常情况下，您可以复制整张表格并解决问题。我遇到的问题是，每个用户都需要能够在自己的工作簿中记录他们自己的进程旁边的数据。有没有一种方法可以对此进行编码，以便将主表中的新行计入并添加到所有其他行中，而不会擦除/移动每个用户所做的标记？我一直在试图找到一种方法来让它“插入”行，如果它们在主服务器中是新的，那么这将保留数据，但无法弄清楚。另外，由于服务器在工作时的安全性 - 链接工作簿等不是一种选择。有没有人有这个想法？

Answer 1

解决此问题的一种方法是使用Scripting.Dictionary对象。您可以为目标和源标识符创建一个字典并进行比较。我想你并不需要Key-Value对来实现这个目标，但希望这能让你走上正轨！

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