简体   繁体   English

使用另一个 Excel 工作簿更新 Excel 工作簿中的数据库

[英]Updating data base from an Excel workbook with another Excel workbook

I have to update an excel data base that contains data from projects.我必须更新一个包含项目数据的 excel 数据库。 Every week I have to download the new database that my company creates, with new projects and updated data from old projects.每周我都必须下载我公司创建的新数据库,其中包含新项目和旧项目的更新数据。 I want to create a macro that does this (update the new information from old projects and add new projects).我想创建一个执行此操作的宏(更新旧项目中的新信息并添加新项目)。 The project names are unique.项目名称是唯一的。 I tried using the next code to update the data automatically, but it doesn't do anything (my data base doesn't change) and I don't know why (every project is a row and every data from the project is a column)我尝试使用下一个代码自动更新数据,但它没有做任何事情(我的数据库没有改变),我不知道为什么(每个项目都是一行,项目中的每个数据都是一列)

    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

I believe the main problem with your code is that you are declaring and setting the worksheet as AcitveWorkbook and same for worksheet, and when working with more than one workbook, you should fully qualify your ranges, as you may be viewing another workbook and VBA will assume that that is the active one.我相信您的代码的主要问题是您将工作表声明并设置为 AcitveWorkbook 和工作表相同,并且在使用多个工作簿时,您应该完全限定您的范围,因为您可能正在查看另一个工作簿,而 VBA 将假设那是活跃的。

I've also did the transfer of data in a single line of code by copying a range into your destination.我还通过将一个范围复制到您的目的地,在一行代码中完成了数据传输。

You also had a typo on your second For Loop, instead of LastRow2 you had LastoRow2...你的第二个 For 循环也有错别字,而不是 LastRow2 你有 LastRow2 ......

Also i and j should be declared as Long instead of integers, have a look at the code below:另外 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

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM