如何使用VBA用来自其他excel文件的新数据覆盖数据库中的数据？

编程问答 2022-05-15

问题描述

我想使用 VBA 将源文件中的数据发送到主文件。这是我的脚本：

Sub TransferData()    
    Dim main_wb As Workbook,target_wb As Workbook,main_sheet As String
    Dim r As String,target_sheet As String,first_col As Byte,col_n As Byte
    Dim next_row As Long,duplicates As Byte,pasted As Byte,last_col As Long
    
    'CONfig HERE
    '------------------------
    Set main_wb = ThisWorkbook
    main_sheet = "Sheet1"
    r = "B6:G6" 'range to copy in the main Workbook
    
    'target workbook path
    Set target_wb = Workbooks("Main File.xlsm")
    'Workbooks.Open ("/Users/user/Desktop/target workbook.xlsm")
    
    target_sheet = "DataBase"
    first_col = 2 'in what column does the data starts in target sheet?
    '-------------------------
    
    'turn screen updating off
    Application.ScreenUpdating = False
    
    'copy from main
    main_wb.Sheets(main_sheet).Range(r).copy
    
    With target_wb.Sheets(target_sheet)
        'target info
        next_row = _
        .Cells(Rows.Count,first_col).End(xlUp).Row + 1
        
        'paste in target
        .Cells(next_row,first_col).PasteSpecial Paste:=xlPasteValues
        
        last_col = _
        .Cells(next_row,Columns.Count).End(xlToLeft).Column
    End With
    
    pasted = last_col - (first_col - 1)
    
    For col_n = first_col To last_col
        With target_wb.Sheets(target_sheet)
            If .Cells(next_row,col_n) = .Cells(next_row - 1,col_n) Then          
                 duplicates = duplicates + 1  
            End If
        End With
    Next col_n
    
    If duplicates = pasted Then 'if the nº of cells pasted equals duplicates
        For col_n = first_col To last_col  'erase pasted range
            target_wb.Sheets(target_sheet).Cells(next_row,col_n).Clear
        Next col_n
    End If
    
    'turn screen updating back on
    Application.ScreenUpdating = True
End Sub

如果主文件中的前一行与来自源文件的新行数据完全相同，脚本可以防止数据再次粘贴到主文件中。但是，一旦源文件中有一些新的更新并且数据再次传输，脚本会将其视为新行而不是更新现有行。下面第一个截图是源文件中的数据，第二个截图是主文件中的数据库：

enter image description here

enter image description here

正如您在上面的屏幕截图中看到的，当我更新源文件中的单元格 C6 并将数据传输到主文件时，它将创建 Row4 而不是更新 Row3 中的数据。我可以知道我应该如何修改我的脚本，以便只要日期相同，它就会更新现有行而不是创建新行吗？任何帮助将不胜感激！

解决方法

它可能如下所示。我简化了这个例子。

请注意，我建议不要使用 URL，而是为范围 InputSheet.Range("B6:G6") 指定一个类似 B6:G6 的名称，然后使用 InputRange。因此，如果您添加一列，则无需再次触摸代码。

InputSheet.Range("InputRange")
databasedatabasedatabaseexcelexcelsendsendsendvba