Question

我必须更新包含项目数据的Excel数据库。每周我都要下载我公司创建的新数据库，新项目和旧项目的更新数据。我想创建一个执行此操作的宏（从旧项目更新新信息并添加新项目）。项目名称是唯一的。我尝试使用下一个代码自动更新数据，但它没有做任何事情（我的数据库没有改变），我不知道为什么（每个项目都是一行，项目中的每个数据都是一列）

    Sub UpdateData()

Dim h1 As Workbook 'workbook where the data is to be pasted
Dim s1 As Worksheet
Dim h2   As Workbook 'workbook from where the data is to copied
Dim s2 As Worksheet
Dim strName  As String   'name of the source sheet/ target workbook
Dim aCell As Range, bCell As Range
    Dim SearchString As String
    Dim ExitLoop As Boolean, matchFound As Boolean

'set to the current active workbook (the source book)
Set h2 = ActiveWorkbook
Set s2 = ActiveSheet

Set h1 = Workbooks.Open("C:\Users\BAICFL\Desktop\macro prueba.xlsx")
Set s1 = h1.Worksheets("Sheet1")


s2.Activate
Dim col As Long
Dim LastRow1 As Long
    Dim row As Long
Dim i As Integer
Dim j As Integer
with s1
LastRow1 = .Range("E" & .Rows.Count).End(xlUp).Row
End With
with s2
LastRow2 = .Range("E" & .Rows.Count).End(xlUp).Row
End With


For i = 1 To LastRow1
  For j = 1 To LastoRow2


If s2.Range("E" & j).Value = s1.Range("E" & i).Value Then

s1.Range("D" & i).Value = s2.Range("D" & j).Value
s1.Range("F" & i).Value = s2.Range("F" & j).Value
s1.Range("G" & i).Value = s2.Range("G" & j).Value
s1.Range("H" & i).Value = s2.Range("H" & j).Value
s1.Range("I" & i).Value = s2.Range("I" & j).Value
s1.Range("J" & i).Value = s2.Range("J" & j).Value
s1.Range("K" & i).Value = s2.Range("K" & j).Value
s1.Range("L" & i).Value = s2.Range("L" & j).Value
s1.Range("M" & i).Value = s2.Range("M" & j).Value
s1.Range("N" & i).Value = s2.Range("N" & j).Value
s1.Range("O" & i).Value = s2.Range("O" & j).Value
s1.Range("P" & i).Value = s2.Range("P" & j).Value
s1.Range("Q" & i).Value = s2.Range("Q" & j).Value
s1.Range("R" & i).Value = s2.Range("R" & j).Value
s1.Range("S" & i).Value = s2.Range("S" & j).Value
s1.Range("T" & i).Value = s2.Range("T" & j).Value


End If
Next
Next
End Sub

Answer 1

我认为您的代码的主要问题是您声明并将工作表设置为AcitveWorkbook并且工作表相同，并且在处理多个工作簿时，您应该完全限定范围，因为您可能正在查看另一个工作簿并且VBA将假设这是活动的。

我还通过将一个范围复制到您的目的地，在一行代码中传输数据。

你的第二个For循环也有拼写错误，而不是LastRow2你有LastoRow2 ......

此外，i和j应声明为Long而不是整数，请看下面的代码：

Sub UpdateData()
Dim LastRow1 As Long, LastRow2 As Long, i As Long, j As Long
Dim h1 As Workbook
Dim s1 As Worksheet
Dim h2 As Workbook: Set h2 = ThisWorkbook
Dim s2 As Worksheet: Set s2 = h2.Worksheets("Sheet1")
'declare and set your workbook/worksheet amend as required

Set h1 = Workbooks.Open("C:\Users\BAICFL\Desktop\macro prueba.xlsx")
Set s1 = h1.Worksheets("Sheet1")

LastRow1 = s1.Cells(s1.Rows.Count, "E").End(xlUp).row
LastRow2 = s2.Cells(s2.Rows.Count, "E").End(xlUp).row

For i = 1 To LastRow1
    For j = 1 To LastRow2
        If s2.Range("E" & j).Value = s1.Range("E" & i).Value Then
             s1.Range("D" & i & ":T" & i).Copy s2.Range("D" & j & ":T" & j)
        End If
    Next j
Next i
End Sub

使用其他Excel工作簿从Excel工作簿更新数据库

1 个答案: