Question

我有一张包含2张的工作簿：Masterlist（旧数据）和Results（新数据），在A列中包含唯一标识符。

我试图找到一种方法将包含Results标签中最新数据的行复制到Masterlist表格中的匹配行

我只能找到一种方法来复制Masterlist

底部的新数据

Sub UpdateML()

Dim wM As Worksheet,  wR As Worksheet
Dim r1 As Range, r2 As Range
Dim cel1 As Range, cel2 As Range
Dim LastRow As Long
Application.ScreenUpdating = False

Set wM = ThisWorkbook.Worksheets("MasterList")
Set wR = ThisWorkbook.Worksheets("Results")

    With wM
    Set r1 = .Range("A1", .Cells(.Rows.Count, .Columns("A:A").Column).End(xlUp))
End With

With wR
    Set r2 = .Range("A1", .Cells(.Rows.Count, .Columns("A:A").Column).End(xlUp))
End With

On Error Resume Next
For Each cel1 In r1
    With Application
        Set cel2 = .Index(r2, .Match(cel1.Value, r2, 0)) 'find match in Masterlist
        If Err = 0 Then
            copyResult cel2 'copy result to masterlist
        End If
        Err.Clear

End With

Next cel1

End Sub

Sub copyResult(cel As Range)

Dim w As Worksheet, r As Range
Set w = ThisWorkbook.Worksheets("Masterlist")
Set r = w.Cells(w.Rows.Count, Columns("A:A").Column).End(xlUp).Offset(1) 'next row
cel.EntireRow.Copy w.Cells(r.Row, 1)

End Sub

Answer 1

你的copyResult方法（设置r的值时）正在拾取底行+ 1，这就是为什么它被转储到列表底部的原因。

但是，在UpdateML方法中有一个LastRow变量，该变量未使用。我通过使用它作为计数器变量来跟踪行索引并将其传递到copyResult方法中，从而使它工作。像这样：

Sub UpdateML()
    Dim wM As Worksheet, wR As Worksheet
    Dim r1 As Range, r2 As Range
    Dim cel1 As Range, cel2 As Range
    Dim LastRow As Long
    Application.ScreenUpdating = False

Set wM = ThisWorkbook.Worksheets("MasterList")
Set wR = ThisWorkbook.Worksheets("Results")

With wM
    Set r1 = .Range("A1", .Cells(.Rows.Count, .Columns("A:A").Column).End(xlUp))
End With

With wR
    Set r2 = .Range("A1", .Cells(.Rows.Count, .Columns("A:A").Column).End(xlUp))
End With

LastRow = 1

On Error Resume Next
For Each cel1 In r1
    With Application
        Set cel2 = .Index(r2, .Match(cel1.Value, r2, 0)) 'find match in Masterlist
        If Err = 0 Then
            copyResult cel2, LastRow 'copy result to masterlist
        End If
        Err.Clear
        LastRow = LastRow + 1
    End With
Next cel1
End Sub

Sub copyResult(cel As Range, row As Long)
    Dim w As Worksheet
    Set w = ThisWorkbook.Worksheets("Masterlist")
    cel.EntireRow.Copy w.Cells(row, 1)
End Sub

我对VBA有点生疏（大约一年没用过），所以可能会有更优雅的解决方案，但这绝对是一种选择。

Answer 2

这是一种不同的方法。它使用“Find”，它更精简。它还使用activesheets和cells而不是引用。

您是否需要将结果中缺少的项目添加到主列表中？这涵盖了这一点。如果结果col A与MasterList col A相同，那么这也将起作用

Sub itworks()
'''covers the above
On Error Resume Next ''Can change this to more preferred if error <> 0
Sheets("MasterList").Range("a1").Select
lo = Range("A" & Range("A:A").Rows.Count).End(xlUp).Offset(1).Address
Do Until ActiveCell.Address = lo
Sheets("Results").Range("A:A").Find(ActiveCell.Value).EntireRow.Copy ActiveCell''copies found row to your Active Cell
ActiveCell.Offset(1).Select
Loop
''Adds missing rows
Sheets("Results").Activate
Range("a1").Select
lo2 = Range("A" & Range("A:A").Rows.Count).End(xlUp).Offset(1).Address
Do Until ActiveCell.Address = lo2
Set missing = Sheets("MasterList").Range("A:A").Find(ActiveCell.Value)
If missing Is Nothing Then
ActiveCell.EntireRow.Copy Sheets("MasterList").Range("a1").End(xlDown).Offset(1)
End If
ActiveCell.Offset(1).Select
Loop
End Sub

当/如果值匹配时VBA复制行* Brain Fried *

2 个答案: