VBA更新和仅插入另一个工作簿中的新数据

问题描述

编辑，以便更明确：

想象两个工作簿A和B。B是通过外部程序以.xlsx格式导出的。无法修改。

在第1周中，我使用来自工作簿B的数据更新了工作簿A。

Workbook A after Step 1.

在第一周，我在Workbook A上工作，在Item列中填充数据。

Workbook A after Step 2.

在第1周中，我再次使用来自工作簿B的数据更新了工作簿A。但是请注意，有些行不在同一位置（绿色行），另一些行进行了一些修改，而另一些则是新的。

What I want to have in Workbook A after Step 3.

现在我有了以下代码：

Sub Update()

Dim lastRowScr As Integer,lastRowLocal As Integer,nRowsSrc As Integer,nRowsLocal As Integer,x As Integer,_
y As Integer

    Application.ScreenUpdating = False
    
       Set closedBook = Workbooks.Open("C:\Users\mfortesg\Documents\Suivi d'Analyses AT\Projet - Automatisation\BO\BO.xlsx")
       
       lastRowScr = closedBook.Sheets(1).Cells.Find(What:="*",SearchDirection:=xlPrevIoUs).Row - 2
       nRowsScr = lastRowScr - 16
       
       lastRowLocal = ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells.Find(What:="*",SearchDirection:=xlPrevIoUs).Row
       nRowsLocal = lastRowLocal - 2
       
       If nRowsLocal = 0 Then
       
            For x = 17 To lastRowScr
            
                y = x - 14
                        
                ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y,1).Value = closedBook.Sheets(1).Cells(x,1).Value
                ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y,2).Value = closedBook.Sheets(1).Cells(x,2).Value
                ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y,3).Value = closedBook.Sheets(1).Cells(x,3).Value
                ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y,4).Value = closedBook.Sheets(1).Cells(x,4).Value
                ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y,5).Value = closedBook.Sheets(1).Cells(x,17).Value
                ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y,6).Value = closedBook.Sheets(1).Cells(x,11).Value
                ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y,7).Value = closedBook.Sheets(1).Cells(x,10).Value
                ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y,8).Value = closedBook.Sheets(1).Cells(x,26).Value
                ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y,24).Value = Replace(closedBook.Sheets(1).Cells(x,28).Value,",":")
            
            Next x
            
            MsgBox ("Le Tableau d'Analyse AT a été mis à jour correctement.")
        
            Else
            
            For x = 17 To lastRowScr
    
                For y = x - 14 To lastRowLocal + 1
                    
                    If ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y,1).Value And _
                       ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y,2).Value And _
                       ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y,":") Then
                    
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y,11).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y,17).Value
                        
                    ElseIf y = lastRowLocal + 1 Then
                                    
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14,1).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14,2).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14,3).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14,4).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14,17).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14,11).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14,10).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14,26).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14,":")
                    
                    End If
                    
                Next y
            
            Next x
            
            MsgBox ("Le Tableau d'Analyse AT a été mis à jour correctement.")
        
        End If
            
       closedBook.Close SaveChanges:=False

     
    Application.ScreenUpdating = True

End Sub

它无法按需工作。

解决方法

您的外部程序可以为每个条目生成唯一的ID吗？如果是，则可以使用它来验证新行。

如果没有，我认为最好的方法是使用concatenate和vlookup验证唯一条目，然后插入新行，如下所示：

在工作簿A的E列中，使用：

=CONCATENATE(A1,B1,C1)

在工作簿C的C列中，使用：

=IF(ISNA(VLOOKUP(CONCATENATE(A1,C1),[Workbook A]Sheet1!C5,1,0),"NEW","DUPLICATE")

最后，您可以在代码中验证单元格值是否为“ NEW”并将其插入到工作簿A中。

excel excel updates