vba 在VBA中将数据从一张工作表更新到Excel中的适当列和行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/15810896/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Update Data to appropriate Column and row in excel from one sheet to another in VBA
提问by Hamed MP
As I mentioned in the title, I need to copy Data from one Sheet to another.I have the same data (not in the same order) in both sheets. I want to update data in the 1st sheet as the corresponding row in 2nd one changed. For example I have in the First sheet:
正如我在标题中提到的，我需要将数据从一张工作表复制到另一张工作表。我在两张工作表中都有相同的数据（顺序不同）。我想更新第一张工作表中的数据，因为第二张工作表中的相应行发生了变化。例如我在第一张表中有：
A B C
1 one 1.1
2 two 1.2
3 three 1.3
4 one + two 2.3
5 one + three ??
and in the 2nd one:
在第二个：
A B C
1 one 1.1
2 two 1.2
3 three 1.3
As I write in the 2nd, the Update button will update the rows that changed and also try to find if any row has the form "one + three". So, it will also copy data from "one" and "three" to that row. In the future if another multiname row (like :one + four or two + three) added, the button will do the same thing .
正如我在第二篇中所写，更新按钮将更新更改的行，并尝试查找是否有任何行具有“一+三”形式。因此，它还会将数据从“一”和“三”复制到该行。将来如果添加另一个多名称行（如：一+四或二+三），按钮将做同样的事情。
I try to update all data in the sheet by this code :
我尝试通过以下代码更新工作表中的所有数据：
Private Sub CommandButton2_Click()
Dim salesData As Range, targetRng As Range
Dim e As Integer
Set salesData = Worksheets("sheet1").Range("A2:C" & Range("A1").End(xlDown).Row)
If Worksheets("sheet2").Range("B2") = vbNullString Then
Set targetRng = Worksheets("sheet2").Range("A2") 'If no data in SalesDB start in row 2
Else
Set targetRng = Worksheets("sheet2").Range("A1").End(xlDown).Offset(1, 0) 'If data already in SalesDB, find next free row
End If
salesData.Copy Destination:=targetRng
End Sub
but it doesn't useful for me as: 1 Copy all data (it's time consuming and also because of "Worksheets("sheet2").Range("B2") = vbNullString" it adds data to the rest of the empty rows, not update them)
但它对我没有用，因为： 1 复制所有数据（这很耗时，也因为“Worksheets("sheet2").Range("B2") = vbNullString” 它会将数据添加到其余的空行，不更新它们）
2-I can't check the value of the column B to see if there is such a field named "one + three" to update it.
2-我无法检查B列的值，看是否有名为“一+三”这样的字段来更新它。
At the end, don't forget that: I'm new in VBA and excel programming!! Thank you in advance
最后，不要忘记：我是 VBA 和 excel 编程的新手！！先感谢您
Update 1::
更新 1::
Private Sub CommandButton5_Click()
'here the beginning of of your solution
'after and instead of this line:
'salesData.Copy Destination:=targetRng
'try this... but carefully for the first time :)
Dim salesData As Range, targetRng As Range
Dim e As Integer
Set salesData = Worksheets("sheet1").Range("A2:C" & Range("A1").End(xlDown).Row)
' Worksheets("Sheet2").Select
If Worksheets("sheet2").Range("B2") = vbNullString Then
Set targetRng = Worksheets("sheet2").Range("A2") 'If no data in SalesDB start in row 2
Else
Set targetRng = Worksheets("sheet2").Range("A1").End(xlDown).Offset(1, 0) 'If data already in SalesDB, find next free row
End If
targetRna.Columns(3).ClearContents
Dim dataItem
Dim Found As Range
Dim rngStart As Range
Set rngStart = targetRna.Cells(1, 1)
Dim strFirstAddress As String
For Each dataItem In salesData.Columns(2).Cells
Set Found = targetRna.Find(dataItem.Value, rngStart, xlValues, xlPart)
If Not Found Is Nothing Then
strFirstAddress = Found.Address
Do
If dataItem.Value = Found.Value Then
Found.Offset(0, 1) = dataItem.Offset(0, 1)
Else
Found.Offset(0, 1) = Found.Offset(0, 1) + dataItem.Offset(0, 1)
End If
Set rngStart = Found
Set Found = targetRna.Find(dataItem.Value, rngStart, xlValues, xlPart)
If Found Is Nothing Then
Exit Do
ElseIf Found.Address = strFirstAddress Then
Exit Do
End If
Loop
End If
Next
End Sub
Edit2:: ()clear space in the address to see the image ![the button will affect this sheet][1] [1]: http://i.stack.imgur.com/zSg1p.png
Edit2::()清空地址空间看图片！[按钮会影响这张表][1][1]：http: //i.stack.imgur.com/zSg1p.png
![The Update button will be here][2] [2]: http://i.stack.imgur.com/sNiVK.png
![更新按钮将在此处][2] [2]：http: //i.stack.imgur.com/sNiVK.png
采纳答案by Kazimierz Jawor
Instead of your:
而不是你的：
salesData.Copy Destination:=targetRng
try to use the following code:
尝试使用以下代码：
Private Sub CommandButton2_Click()
'here the beginning of of your solution
'after and instead of this line:
'salesData.Copy Destination:=targetRng
'try this... but carefully for the first time :)
targetRna.Columns(3).ClearContents
Dim dataItem
Dim Found As Range
Dim rngStart As Range
Set rngStart = targetRna.Cells(1, 1)
Dim strFirstAddress As String
For Each dataItem In salesData.Columns(2).Cells
Set Found = targetRna.Find(dataItem.Value, rngStart, xlValues, xlPart)
If Not Found Is Nothing Then
strFirstAddress = Found.Address
Do
If dataItem.Value = Found.Value Then
Found.Offset(0, 1) = dataItem.Offset(0, 1)
Else
Found.Offset(0, 1) = Found.Offset(0, 1) + dataItem.Offset(0, 1)
End If
Set rngStart = Found
Set Found = targetRna.Find(dataItem.Value, rngStart, xlValues, xlPart)
If Found Is Nothing Then
Exit Do
ElseIf Found.Address = strFirstAddress Then
Exit Do
End If
Loop
End If
Next
End Sub
EDITED: So, once again...I hope I didn't miss any part of your concept. I'm not sure because you writing about copy from sheet1 to sheet2 while your code copy from sheet2 to sheet1. 
编辑：所以，再一次......我希望我没有错过你的概念的任何部分。我不确定，因为你写的是从 sheet1 到 sheet2 的复制，而你的代码从 sheet2 复制到 sheet1。
And the complete code:
以及完整的代码：
Private Sub CommandButton2_Click()
Dim salesData As Range, targetRng As Range
Dim e As Integer
Set salesData = Worksheets("sheet2").Range("A1:C" & Range("A1").End(xlDown).Row)
If Worksheets("sheet1").Range("B2") = vbNullString Then
Set targetRng = Worksheets("sheet1").Range("A2") 'If no data in SalesDB start in row 2
salesData.Copy Destination:=targetRng
Exit Sub
Else
'if data already exists than set range to search in
Set targetRng = Worksheets("sheet1").Range("A1").CurrentRegion
End If
targetRng.Columns(3).ClearContents
Dim boFound As Boolean
Dim dataItem
Dim Found As Range
Dim rngStart As Range
Set rngStart = targetRng.Cells(1, 1)
Dim strFirstAddress As String
For Each dataItem In salesData.Columns(2).Cells
Set Found = targetRng.Find(dataItem.Value, rngStart, xlValues, xlPart)
If Not Found Is Nothing Then
strFirstAddress = Found.Address
boFound = True
Do
If dataItem.Value = Found.Value Then
Found.Offset(0, 1) = dataItem.Offset(0, 1)
Else
Found.Offset(0, 1) = Found.Offset(0, 1) + dataItem.Offset(0, 1)
End If
Set rngStart = Found
Set Found = targetRng.Find(dataItem.Value, rngStart, xlValues, xlPart)
If Found Is Nothing Then
Exit Do
ElseIf Found.Address = strFirstAddress Then
Exit Do
End If
Loop
End If
If Not boFound Then
'if not found then copy into first free row
dataItem.Offset(0, -1).Resize(1, 3).Copy Worksheets("sheet1").Range("A1").End(xlDown).Offset(1, 0)
End If
boFound = False
Next
End Sub
