Замена значений в одной таблице на значения из другой

[1134]

Существуют две структурно одинаковые таблицы. Все строки, которые есть во 2-ой (более короткой таблице) есть и в 1-ой (более длинной) различаются лишь последние значения в строках. Хотелось бы заменить последние значения в совпадающих строках в 1-ой таблице на значения из 2-ой. Более наглядное объяснение скрывается во вложенном файле, большое спасибо всем откликнувшимся!

[dzv]

1134, к сожалению Ваш файл открыть не могу (формат 2007).
Я могу лишь посоветовать функцию "связь", при условии, что данные строки не удаляются.

[1134]

Можно немного подробней?

[Volodshan]

Сообщение от 1134

Можно немного подробней?

Формат Excel 97-2003 - "*.xls"

[1134]

Формат Excel 97-2003 - "*.xls"

[Maxx]

Вот вам код:

Sub DateShift()
Application.ScreenUpdating = False

    Dim i As Integer, valNumber As Variant, valDate As Variant
    
    For i = 2 To Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).Row
        valNumber = Cells(i, 1).Value
        valDate = Cells(i, 2).Value
        
        Range([I2], Cells(Cells(Rows.Count, "I").End(xlUp).Row, "I")).Select
                
        On Error Resume Next
        Selection.Find(valNumber).Activate
                
        If ActiveCell.Value = valNumber Then
            ro = ActiveCell.Row: co = ActiveCell.Column
            Range(Cells(ro - 1, co + 1), Cells(Cells(Rows.Count, "J").End(xlUp).Row, "J")).Select
        
            On Error Resume Next
            Selection.Find(valDate).Activate
        
            If ActiveCell.Value = valDate And ActiveCell.Offset(0, -1).Value = valNumber Then
                Cells(i, 7) = ActiveCell.Offset(0, 5).Value
            Else
                GoTo 1
            End If
        Else
            GoTo 1
        End If
1
    Next i

Application.ScreenUpdating = True
End Sub

[1134]

Спасибо, огромное!

[Maxx]

Немного упростил:

Sub DateShift()
Application.ScreenUpdating = False

    Dim i As Long
    
    For i = 2 To Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).Row
        valNumber = Cells(i, 1).Value: valDate = Cells(i, 2).Value
        
        Range([I2], Cells(Cells(Rows.Count, "I").End(xlUp).Row, "I")).Select
                
        On Error Resume Next
        Selection.Find(valNumber).Activate
                
        If ActiveCell.Value = valNumber Then
            ro = ActiveCell.Row: co = ActiveCell.Column
            Range(Cells(ro - 1, co + 1), Cells(Cells(Rows.Count, "J").End(xlUp).Row, "J")).Select
        
            On Error Resume Next
            Selection.Find(valDate).Activate
        
            If ActiveCell.Value = valDate And ActiveCell.Offset(0, -1).Value = valNumber Then
                Cells(i, 7) = ActiveCell.Offset(0, 5).Value
            End If
        End If
    Next i

Application.ScreenUpdating = True
End Sub

[1134]

А как сделать так, чтобы все значения в последнем ряду, кроме тех что были подставлены выше записанным макросом превратились в "0"?

[Maxx]

Напишите после valNumber = Cells(i, 1).Value: valDate = Cells(i, 2).Value
следующее:
Cells(i, 7).Value = 0