Question

现在我有一个雇员用来输入数据的主excel工作簿。他们每个人都会将副本下载到他们的桌面，然后通过输入＆＃34; x＆＃34;来标记他们在各种条目上的进度。在他们完成的数据旁边的一个comlun中。每个产品都有自己的行，并在该行中列出其各自的数据。整个季度都会填写主工作簿，并在产品可用时提供新的数据，目前通过使用宏来复制每个个人工作簿，该宏只复制数据的范围（参见下面的代码）。

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目前无法处理此行更改，因为它只是从预定义范围复制/粘贴。每个用户的工作簿都没有在行＃中获取此更改，因此列中的数据与错误的行相关联。通常，您可以复制整个工作表并解决问题。我遇到的问题是每个用户都需要能够在他们自己的工作簿中记录他们自己的数据。有没有办法对此进行编码，以便在不删除/移动每个用户所做的标记的情况下，将主表上的新行计算并添加到所有其他行？我一直试图找到一种方法来制作它＆＃34;插入＆＃34;行如果他们在主人中是新的，因为这会保留数据，但无法弄明白。此外，由于工作链接工作簿上的服务器安全性等，不是一种选择。有没有人对此有任何想法？

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

插入行VBA

1 个答案: