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

VBA Updating and inserting only new data from another workbook

编辑更明确:

假设有两个工作簿 A 和 B。B 通过外部程序以 .xlsx 格式导出。无法修改。

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

Workbook A after Step 1.

  1. 在第 1 周,我处理工作簿 A,用数据填充项目列。

Workbook A after Step 2.

  1. 在第 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 = closedBook.Sheets(1).Cells(x, 1).Value And _
                       ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y, 2).Value = closedBook.Sheets(1).Cells(x, 2).Value And _
                       ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(y, 24).Value = Replace(closedBook.Sheets(1).Cells(x, 28).Value, ",", ":") Then
                    
                        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, 5).Value = closedBook.Sheets(1).Cells(x, 17).Value
                        
                    ElseIf y = lastRowLocal + 1 Then
                                    
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14, 1).Value = closedBook.Sheets(1).Cells(x, 1).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14, 2).Value = closedBook.Sheets(1).Cells(x, 2).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14, 3).Value = closedBook.Sheets(1).Cells(x, 3).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14, 4).Value = closedBook.Sheets(1).Cells(x, 4).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14, 5).Value = closedBook.Sheets(1).Cells(x, 17).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14, 6).Value = closedBook.Sheets(1).Cells(x, 11).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14, 7).Value = closedBook.Sheets(1).Cells(x, 10).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14, 8).Value = closedBook.Sheets(1).Cells(x, 26).Value
                        ThisWorkbook.Sheets("Tableau d'Analyse AT").Cells(x - 14, 24).Value = Replace(closedBook.Sheets(1).Cells(x, 28).Value, ",", ":")
                    
                    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? 如果是,您可以使用它来验证新行。

如果没有,我认为最好的方法是使用 concatenatevlookup 来验证唯一条目然后插入新行,就像这样:

在工作簿 A 的 E 列中,使用:

=CONCATENATE(A1,B1,C1)

在工作簿 C 的 C 列中,使用:

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

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