比较两个工作簿-删除与wkb 2匹配的行-将值从wkb 2添加到wkb 1(差异处)

Question

希望你能帮我把不同的部分拼凑起来。

我有两本工作簿，wkbPB (基金会)，wkbZLISTP (与wkbPB比较)。这两个工作簿都有两列包含项目no。列出价格。我需要比较一下每件商品的单价。在wkbPB里有那件商品的单价。在wkbZLISTP中。

• ，在文章no中有匹配的地方。并且列表价差小于0.04，删除wkbPB.
• 中的行，在条目no中有匹配项。而清单价差大于0.04，wkbZLISTP的价目表需要写在wkbPB的标价旁边的一栏中，
• 如果在第0条中没有匹配，则将“缺失”写到wkbPB红色标价旁边的另一栏中。

。

目前，我正在使用包含查找对话框的For Next循环来执行此任务。它能完成任务，但要花45分钟才能完成。现在，我已经搜索了互联网，并通过数组找到了一个比较，这似乎是闪电般的快。Example。

然而，我不能团结在一起，为了我的目的，完全冻结大脑，如何定制那个代码。你能帮上忙吗？

经常这样！

Dim d As Long
For d = 2 To noOfRowsPB Step 1
    If wkbPB.Worksheets(1).Cells(d, 1).Value <> "" Then
        Dim looking4 As String
        looking4 = UCase(wkbPB.Worksheets(1).Cells(d, 26).Value)
        Dim ctrUPNRng As Range
        Dim ctrUPNRow As Long
        Set ctrUPNRng = wkbZLISTP.Worksheets(1).Cells.Find(looking4, After:=Range("A1"), LookIn:=xlFormulas, LookAt _
            :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        If Not ctrUPNRng Is Nothing Then
            ctrUPNRow = ctrUPNRng.Row
            If Abs(CSng(wkbPB.Worksheets(1).Cells(d, 24).Value) - CSng(wkbZLISTP.Worksheets(1).Cells(ctrUPNRow, 14).Value)) > 0.04 Then
                wkbPB.Worksheets(1).Cells(d, 27).Value = wkbZLISTP.Worksheets(1).Cells(ctrUPNRow, 14).Value
            Else
                 Rows(d).EntireRow.Delete Shift:=xlUp
                 d = d - 1
            End If
        Else
            wkbPB.Worksheets(1).Cells(d, 27).Value = "MISSING"
            With wkbPB.Worksheets(1).Range("AA" & d).Font
                .Color = -16776961
                .TintAndShade = 0
            End With
        End If
    Else
        Exit For
    End If
Next d

Answer 1

它花了一段时间，但我已经设法让它自己工作了！

我所需要的就是把一个数组的正确图片放进我的脑子里！这其实很简单:数组只不过是一个表。因此，您从工作表中获取数据的范围，并将该范围分配给一个数组！完成了！

嗯，还有几个挑战要克服，但有了这样的基本理解，我才能让它发挥作用！

看看时间节约:旧宏: 33:43分钟，新宏: 7:31分钟！

这就是现在的样子：

Dim d As Long
Dim PBArray As Variant
Dim ZLISTPArray As Variant
Dim f As Long
Dim rngPB As Range
Dim rngZLISTP As Range
Dim rowDel As Long
noOfRowsPB = wkbPB.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
noOfRowsZLISTP = wkbZLISTP.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
Set rngPB = wkbPB.Worksheets(1).Range(Cells(2, 1), Cells(noOfRowsPB, 26))
PBArray = rngPB
wkbZLISTP.Activate
Set rngZLISTP = wkbZLISTP.Worksheets(1).Range(Cells(2, 1), Cells(noOfRowsZLISTP, 19))
ZLISTPArray = rngZLISTP

rowDel = 0
For d = 1 To UBound(PBArray)
    For f = 1 To UBound(ZLISTPArray)
        'Can we find it?
        If PBArray(d, 26) = ZLISTPArray(f, 19) Then
            'Found it, now price comparison
            If Abs(PBArray(d, 24) - ZLISTPArray(f, 14)) > 0.04 Then
               'Price difference, we want to see it
               wkbPB.Worksheets(1).Cells(d + 1 - rowDel, 27).Value = wkbZLISTP.Worksheets(1).Cells(f + 1, 14).Value
               Exit For
            Else
                'No price difference, we can delete it
                wkbPB.Worksheets(1).Rows(d + 1 - rowDel).EntireRow.Delete Shift:=xlUp
                rowDel = rowDel + 1
                Exit For
            End If
        ElseIf f = UBound(ZLISTPArray) Then
            'Despite searching to the end, no findings, then we need to make that visible too
            wkbPB.Worksheets(1).Cells(d + 1 - rowDel, 27).Value = "MISSING"
            With wkbPB.Worksheets(1).Range("AA" & d + 1 - rowDel).Font
                .Color = -16776961
                .TintAndShade = 0
            End With
        End If
    Next f
Next d

也许有一天这个也能帮到别人！

享受吧！