VBA多条件跨工作簿逆向匹配数据

3190496160

哎哟哥哥 发表于 2023-2-5 10:29
有销售合同的用销售合同对应的采购价，没销售合同的，用最后一次采购价。

目前的代码思路就是这样来写的。至于还有问题，要针对存在的问题做具体描述

哎哟哥哥

3190496160 发表于 2023-2-5 10:48
目前的代码思路就是这样来写的。至于还有问题，要针对存在的问题做具体描述

比如：3010120101物料，您代码匹配的结果是3479，正确结果是4548

chr78228

楼主的意思应该是优先匹配 合同号和物料编号两个条件 取值单价 算出金额
同时要 换算 气泡膜和拉伸膜的单价

如果两个条件不能同时满足 则取匹配物料编号一个条件的单价 换算单价 算出金额

哎哟哥哥

chr78228 发表于 2023-2-5 11:40
楼主的意思应该是优先匹配 合同号和物料编号两个条件 取值单价 算出金额

对，优先匹配合同号和物料号两个条件的价格，如果匹配不到，再来用物料号匹配价格。但都是逆向匹配，从查询采购合同明细最后请（最下方）往上匹配。合同号就是工作表名字。

shiruiqiang

所以先满足2个条件，没有就满足一个条件

哎哟哥哥

shiruiqiang 发表于 2023-2-5 11:53
所以先满足2个条件，没有就满足一个条件

非常感谢，我照抄下来试试吧。

3190496160

Sub 匹配()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
lj = ThisWorkbook.Path & "\"
f = Dir(lj & "查询采购合同明细.xls*")
If f = "" Then MsgBox "找不到查询采购合同明细文件": End
With ActiveSheet
    ht = .Name
    rs = .Cells(Rows.Count, 1).End(xlUp).Row
    If rs < 2 Then MsgBox "目标表为空！": End
    .Range("g2:h" & rs) = Empty
    ar = .Range("a1:h" & rs)
    Set wb = Workbooks.Open(lj & f, 0)
    With wb.Worksheets(1)
        r = .Cells(Rows.Count, 1).End(xlUp).Row
        br = .Range("a1:h" & r)
    End With
    wb.Close False
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            zf = ht & "|" & Trim(ar(i, 1))
            zd = Trim(ar(i, 1))
            dc(zd) = i
            d(zf) = i
        End If
    Next i
    For i = UBound(br) To 2 Step -1
        If Trim(br(i, 4)) <> "" Then
            zd = Trim(br(i, 1)) & "|" & Trim(br(i, 4))
            xh = d(zd)
            If xh <> "" Then
                If ar(xh, 7) = "" Then
                    If InStr(br(i, 5), "拉伸膜") > 0 Then
                        ar(xh, 7) = br(i, 8) * 110
                    ElseIf InStr(br(i, 5), "气泡膜") > 0 Then
                        ar(xh, 7) = br(i, 8) * 180
                    Else
                        ar(xh, 7) = br(i, 8)
                    End If
                    ar(xh, 8) = ar(xh, 7) * ar(xh, 6)
                End If
            End If
        End If
    Next i
    For i = UBound(br) To 2 Step -1
        If Trim(br(i, 4)) <> "" Then
            h = dc(Trim(br(i, 4)))
            If h <> "" Then
                If ar(h, 7) = "" Then
                    If InStr(br(i, 5), "拉伸膜") > 0 Then
                        ar(h, 7) = br(i, 8) * 110
                    ElseIf InStr(br(i, 5), "气泡膜") > 0 Then
                        ar(h, 7) = br(i, 8) * 180
                    Else
                        ar(h, 7) = br(i, 8)
                    End If
                    ar(h, 8) = ar(h, 7) * ar(h, 6)
                End If
            End If
        End If
    Next i
    .Range("a1:h" & rs) = ar
End With
Set d = Nothing
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

现在看看吧
逆向多条件匹配数据.rar (116.84 KB, 下载次数: 15)

2023-2-5 12:27 上传

点击文件名下载附件

哎哟哥哥

3190496160 发表于 2023-2-5 12:28
现在看看吧

非常感谢，这次对了，只是气泡膜和拉伸膜被弄反了。我是新人没法通过好友，感谢！

3190496160

哎哟哥哥 发表于 2023-2-5 12:44
非常感谢，这次对了，只是气泡膜和拉伸膜被弄反了。我是新人没法通过好友，感谢！

呵呵，说明你也没认真看呗，不是弄反了，而是，你需要的是除以，而代码写成了乘以，自己修改两句代码呗，乘号变除号即可