Как условно добавить строку данных Excel с одного листа на другой?

Question

Я не очень часто использую Excel, но надеюсь, что есть довольно простой способ справиться с этим.Я просмотрел ряд других решений, включающих вставку данных с одного листа на другой, но я не смог найти ничего, что позволило бы (1) сопоставить ячейку с одного листа на другой и затем (2) условно добавить или объединить данныевместо того, чтобы просто вставить его.

У меня есть документ Excel с двумя листами данных.Оба листа содержат столбец с числовым идентификатором.Мне нужно сопоставить идентификаторы из Sheet2 с Sheet1, а затем добавить данные строки из Sheet2 в соответствующие строки из Sheet1.Я думаю, это будет выглядеть примерно так:

If Sheet2 ColumnA Row1 == Sheet1 ColumnA RowX
  Copy Sheet2 Row1 Columns
  Paste (Append) to Sheet1 RowX (without overwriting the existing columns).

Извините, если есть лучший способ сформулировать этот вопрос.Мне удалось представить себя в кругах, и теперь я чувствую, что у меня растерянное лицо Найджела Туфнела.

[Обновление: обновлено, чтобы уточнить ячейки, которые нужно скопировать.]

Answer 1

Я думаю, это то, что вы пытаетесь сделать?

Код не проверен.Я считаю, что это должно работать.Если вы обнаружите какие-либо ошибки, дайте мне знать, и мы примем их там ...

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

Sid

Answer 2

Это должно работать:

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