VBA 仅更新和插入来自另一个工作簿的新数据
VBA Updating and inserting only new data from another workbook
编辑更明确:
假设有两个工作簿 A 和 B。B 通过外部程序以 .xlsx 格式导出。无法修改。
- 在第 1 周,我使用来自工作簿 B 的数据更新工作簿 A。
Workbook A after Step 1.
- 在第 1 周,我处理工作簿 A,用数据填充项目列。
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 = 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?
如果是,您可以使用它来验证新行。
如果没有,我认为最好的方法是使用 concatenate
和 vlookup
来验证唯一条目然后插入新行,就像这样:
在工作簿 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。
编辑更明确:
假设有两个工作簿 A 和 B。B 通过外部程序以 .xlsx 格式导出。无法修改。
- 在第 1 周,我使用来自工作簿 B 的数据更新工作簿 A。
Workbook A after Step 1.
- 在第 1 周,我处理工作簿 A,用数据填充项目列。
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 = 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? 如果是,您可以使用它来验证新行。
如果没有,我认为最好的方法是使用 concatenate
和 vlookup
来验证唯一条目然后插入新行,就像这样:
在工作簿 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。