满足条件精确查找

lidayu

先祝老师新年快乐！请老师赐教要如何实现表中的要求。
满足条件精确查找.rar (269.13 KB, 下载次数: 30)

2019-2-12 11:51 上传

点击文件名下载附件

沈勇

vlookup就可以解决了

tangExcel

这个属于多条件查找，可以使用公式LOOKUP来完成，通用公式：LOOKUP（1,0/（(条件1)*(条件2)*(条件3)）,结果所在的列）

tangExcel 发表于 2019-2-13 14:26
这个属于多条件查找，可以使用公式LOOKUP来完成，通用公式：LOOKUP（1,0/（(条件1)*(条件2)*(条件3)）,结果 ...

请问大侠，如果用VBA来做的话，要怎么做呢？

dequang

April/疑问 发表于 2019-2-13 22:42
请问大侠，如果用VBA来做的话，要怎么做呢？

你的装箱单数据有问题，比如

警察战训帽

海铁公安处领导

袁国辉

男

1

这个在数据源根本没有，还有很多数据是没有的

dequang 发表于 2019-2-14 19:42
你的装箱单数据有问题，比如这个在数据源根本没有，还有很多数据是没有的

这份不是我的，不过我的跟他的有点类似，你能帮我看看吗？

dequang

April/疑问 发表于 2019-2-14 20:04
这份不是我的，不过我的跟他的有点类似，你能帮我看看吗？

你第一个附件里装箱单有的部门数据源里的不大一致，帮你整理了下，大标题的合并单元格也还原了，你看下要上班了，没时间啊，后面的问题一样的话你自己改下吧

Sub 整理()
    '将"数据源"的数据放入数组arr
    arr = Sheets("数据源").Range("a2:f" & Range("a" & Rows.Count).End(xlUp).Row)
    '将"装箱单"中的数据放入数组brr
    brr = Sheets("装箱单").Range("a5:e" & Range("d" & Rows.Count).End(xlUp).Row)

    For i = 1 To UBound(arr)
        If Mid(arr(i, 3), 1, 5) <> "" And Mid(arr(i, 3), 1, 5) <> "海铁公安处" Then
            arr(i, 3) = "海铁公安处" & arr(i, 3)
        End If
    Next
    Sheets("数据源").Range("c2").Resize(UBound(arr), 1) = Application.Index(arr, 0, 3)

    For i = 1 To UBound(brr)
        If brr(i, 3) <> "" And brr(i, 3) <> "姓名" Then
            If Mid(brr(i, 2), 1, 5) <> "海铁公安处" Then
                brr(i, 2) = "海铁公安处" & brr(i, 2)
            End If
        End If
    Next
    Sheets("装箱单").Range("b5").Resize(UBound(brr), 1) = Application.Index(brr, 0, 2)
End Sub



Sub 录入装箱单()
    Sheets("装箱单").Range("e5:e" & Range("d" & Rows.Count).End(xlUp).Row).ClearContents
    '将"数据源"的数据放入数组arr
    arr = Sheets("数据源").Range("a2:f" & Range("a" & Rows.Count).End(xlUp).Row)
    '将"装箱单"中的数据放入数组brr
    brr = Sheets("装箱单").Range("a5:e" & Range("d" & Rows.Count).End(xlUp).Row)

    For i = 1 To UBound(brr)
        '装箱单的空行及标题行跳过
        If brr(i, 3) <> "" And brr(i, 3) <> "姓名" Then
            '以品种名称部门姓名性别作为关键字，如“大檐帽海铁公安处领导袁国辉男”作为关键字进行对比
            x = brr(i, 1) & brr(i, 2) & brr(i, 3) & brr(i, 4)
            For j = 1 To UBound(arr)
                y = arr(j, 1) & arr(j, 3) & arr(j, 4) & arr(j, 5)
                If y = x Then
                    brr(i, 5) = arr(j, 6)  '关键字一样则装入型号
                    Exit For  '在数据源找到时不再往后找，继续装箱单下一个关键字，减少运行时间
                End If
            Next
        End If
    Next
    Sheets("装箱单").Range("e5").Resize(UBound(brr), 1) = Application.Index(brr, 0, 5)
End Sub

dequang

April/疑问 发表于 2019-2-14 20:04
这份不是我的，不过我的跟他的有点类似，你能帮我看看吗？

你看下,要上班了，没时间啊，后面的问题一样的话你自己改下吧

dequang 发表于 2019-2-14 22:02
你看下,要上班了，没时间啊，后面的问题一样的话你自己改下吧

好的，我看看