excel 如何查找两个范围之间的差异，然后复制行

4uqofj5v 于 2023-03-13 发布在其他

关注(0)|答案(1)|浏览(188)

我在两个不同的工作表上有两个订单号列表。第一个列表包含未更新的旧订单号列表，第二个列表包含旧订单号和新订单号（与最新列表相同）。
我试图找出两个列表之间的差异，这两个列表应该输出所有添加的新订单，然后为每个新订单复制整行，并将其复制到第一个列表的末尾。
我希望这是有意义的。我已经尝试了下面只是为了测试我是否可以挑选出所有的新订单号，并复制到第三张表，看看输出是否正确，但没有运气到目前为止。
我更喜欢在VBA中执行此操作，因为我需要使用订单脚本来运行此数据
或许这里有人能帮我。谢谢！

Sub OrderDifferences()
    
    Dim c As Range
    Dim j As Integer
    Dim Souce As Worksheet
    Dim Source2 As Worksheet
    Dim Target As Worksheet
    
    'outdated list'
    Set Source = Worksheets("Open Orders Intern")
    'up-to-date list'
    Set Source2 = Worksheets("New Report")
    'output sheet just to test if output is correct'
    Set Target = Worksheets("test")
    
    j = 1
    For Each c In Source.Range("D5:D250")
        If c <> Source2.Range("D2:D250") Then
            Source2.Rows(c.Row).Copy Target.Rows(j)
            j = j + 1
        End If
    Next c
     
End Sub

excel

来源：https://stackoverflow.com/questions/75700579/how-to-find-differences-between-two-ranges-and-then-copy-the-row

1条答案

按热度按时间

7gs2gvoe1#

复制缺少的行

Sub OrderDifferences()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Source (being read from) - up-to-date list
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("New Report")
    
    Dim srg As Range
    
    With sws.UsedRange
        Dim slCell As Range:
        Set slCell = .Find("*", , xlFormulas, , xlByRows, xlPrevious)
        Set srg = sws.Range("A2", .Cells(slCell.Row, _
            .Cells(.Cells.CountLarge).Column))
    End With
    
   ' Destination (being copied to) - outdated list
    Dim dws As Worksheet: Set dws = wb.Worksheets("Open Orders Intern")
    
    Dim drg As Range, dfcell As Range
    
    With dws.UsedRange
        Dim dlCell As Range:
        Set dlCell = .Find("*", , xlFormulas, , xlByRows, xlPrevious)
        Set drg = dws.Range("A5", .Cells(dlCell.Row, _
            .Cells(.Cells.CountLarge).Column))
        Set dfcell = dws.Cells(dlCell.Row + 1, "A")
    End With
    
    Dim dMatches():
    dMatches = Application.Match(srg.Columns(4), drg.Columns(4), 0)
    
    Dim surg As Range, r As Long
    
    For r = 1 To UBound(dMatches, 1)
        If IsError(dMatches(r, 1)) Then
            If surg Is Nothing Then
                Set surg = srg.Rows(r)
            Else
                Set surg = Union(surg, srg.Rows(r))
            End If
        End If
    Next r
            
    If surg Is Nothing Then
        MsgBox "Old sheet was already up to date.", vbExclamation
    Else
        surg.Copy dfcell
        MsgBox "Old sheet updated.", vbInformation
    End If
    
End Sub

赞(0）回复(0）举报 2023-03-13

我来回答

excel 如何查找两个范围之间的差异，然后复制行

1条答案

复制缺少的行

相关问题

热门标签

最新问答