vba 如何有条件地将一行 Excel 数据从一张工作表附加到另一张工作表？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/9930020/
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
How do I conditionally append a row of Excel data from one sheet to another?
提问by Bijan
I don't use Excel very often, but I'm hoping there is a fairly straightforward way to get through this. I looked through a number of other solutions involving pasting data from one sheet to another, but I couldn't find anything that would allow me to (1) match a cell from one sheet to another and then (2) conditionally append or concatenate data instead of simply pasting it over.
我不经常使用 Excel，但我希望有一种相当简单的方法来解决这个问题。我查看了许多其他解决方案，涉及将数据从一张纸粘贴到另一张纸，但我找不到任何可以让我（1）将一个单元格从一张纸匹配到另一张然后（2）有条件地附加或连接数据的解决方案而不是简单地粘贴它。
I have an Excel document with two sheets of data. Both sheets contain a numerical ID column. I basically need to match the ID's from Sheet2 to the Sheet1 and then append the row data from Sheet2 to the matching rows from Sheet1. I would imagine it will look something like this:
我有一个包含两张数据的 Excel 文档。两个工作表都包含一个数字 ID 列。我基本上需要将来自 Sheet2 的 ID 匹配到 Sheet1，然后将来自 Sheet2 的行数据附加到来自 Sheet1 的匹配行。我想它看起来像这样：
If Sheet2 ColumnA Row1 == Sheet1 ColumnA RowX
Copy Sheet2 Row1 Columns
Paste (Append) to Sheet1 RowX (without overwriting the existing columns).
Sorry if there is a better way to form this question. I've managed to think myself in circles and now I feel like I have a confused Nigel Tufnel look on my face.
对不起，如果有更好的方法来形成这个问题。我已经成功地思考了自己，现在我觉得我的脸上有一种困惑的 Nigel Tufnel 表情。
[Update: Updated to clarify cells to be copied.]
[更新：更新以阐明要复制的单元格。]
回答by Siddharth Rout
I think this is what you are trying to do?
我认为这就是你想要做的？
The code is untested. I believe it should work. If you get any errors, let me know and we will take it form there...
代码未经测试。我相信它应该有效。如果您有任何错误，请告诉我，我们将在那里进行处理...
Sub Sample()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim ws1LR As Long, ws2LR As Long
Dim i As Long, j As Long, LastCol As Long
Dim ws1Rng As Range, aCell As Range
Dim SearchString
Set ws1 = Sheets("Sheet1")
'~~> Assuming that ID is in Col A
'~~> Get last row in Col A in Sheet1
ws1LR = ws1.Range("A" & Rows.Count).End(xlUp).Row
'~~> Set the Search Range
Set ws1Rng = ws1.Range("A1:A" & ws1LR)
Set ws2 = Sheets("Sheet2")
'~~> Get last row in Col A in Sheet2
ws2LR = ws2.Range("A" & Rows.Count).End(xlUp).Row
'~~> Loop through the range in Sheet 2 to match it with the range in Sheet1
For i = 1 To ws2LR
SearchString = ws2.Range("A" & i).Value
'~~> Search for the ID
Set aCell = ws1Rng.Find(What:=SearchString, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'~~> If found
If Not aCell Is Nothing Then
LastCol = ws2.Cells(i, ws2.Columns.Count).End(xlToLeft).Column
'~~> Append values
For j = 2 To LastCol
ws1.Cells(aCell.Row, j).Value = ws1.Cells(aCell.Row, j).Value & " " & ws2.Cells(i, j).Value
Next j
End If
Next i
End Sub
HTH
HTH
Sid
锡德
回答by Francis P
This should work:
这应该有效：
For Each cell2 In Sheet2.UsedRange.Columns(1).Cells
For Each cell1 In Sheet1.UsedRange.Columns(1).Cells
If cell2.Value = cell1.Value Then
Sheet1.Range("B" & cell1.Row & ":Z" & cell1.Row).Value = Sheet2.Range("B" & cell2.Row & ":Z" & cell2.Row).Value
End If
Next cell1
Next cell2
