如何实现多个条件模糊检索名称规格

davidshi

各位VBA前辈高手，请协助如何实现模糊查询，获取数据表格Sheet1材料编码（数据量很大，接近两万行，附件只是粘贴了少量举例）。

名称可填写一个或者两个（OR）；   （AND）材质可填写或者空白，规格填写一个或者两个条件

名称和后边的条件关系是AND


请高手帮忙实现，谢谢。自己写不出来，无运行结果数据。

VBA检索	条件检索
检索结果：	名称		材质	规格			file:///C:/Users/THINKP~1/AppData/Local/Temp/msohtmlclip1/01/clip_image001.png
	R-tee	三通	316	25A	15A
	OR		AND
		and
	名称填写一个或者两个		材质填写或不填写	规格填写一个或者两个

我的思路是想用数组，或者请高手帮忙用字典的方式。我编辑的数组方式运行错误：子过程或函数未定义，条件部分if函数运用也不会不知道是否正确

Sub 物料编码检索()

Dim arrwl()
Dim arrwlbm2()
Dim num1%, c1$, c2$, c3$, c4$, c5$, hs%
num1 = Sheet2.[a100000].End(3).Row
ReDim arrwl(1 To num1, 1 To 3)
ReDim arrwlbm2(1 To 200)
With Sheet2
For i = 1 To num1
arrwl(i, 1) = Worksheets("Sheet1").Cells(i, "A")
arrwl(i, 2) = Worksheets("Sheet1").Cells(i, "I")
arrwl(i, 3) = Worksheets("Sheet1").Cells(i, "J")
Next i
End With

c1 = Worksheets("检索").Range("B4"): c2 = Worksheets("检索").Range("C4"): c3 = Worksheets("检索").Range("D4"): c4 = Worksheets("检索").Range("E4"): c5 = Worksheets("检索").Range("F4")
For i = 2 To num1
  If (InStr(arrwl(i, 2), c1) > 0) Or (InStr(arrwl(i, 2), c2) > 0) Then
       If (InStr(arrwl(i, 3), c3) > 0) And (InStr(arrwl(i, 3), c4) > 0) And (InStr(arrwl(i, 3), c5) > 0) Then
       hs = hs + 1
       arrwlbm2(hs) = arrwl(i, 1)
    End If
    End If
    Next i

For i = 1 To hs
Sheet1.Range("a5:a200").ClearContents
Sheet1.Cells(4 + i, 1) = arrwlbm2(i)
Next i


End Sub

爱疯

1.rar (16.68 KB, 下载次数: 24)

2020-7-20 17:12 上传

点击文件名下载附件

是这样吗

hfwufanhf2006

我模拟你的要求做了一个，没用你的表，在sheet2中；
1、本质上用的是数据有效性，分两个按钮：
     装载参数：第一次查询前需要先装载参数，否则输入框中没有内容可选；
                     每次在修改了sheet1中的源元数据后，也需要再次装载参数，不然就与sheet1中的数据不同步；
     查询：根据选定的参数到sheet1中查找内容；

2、输入框用颜色标记了，只有在这个范围内录入的内容才会被查询到，每个类别有5个单元格可选；
     可以用数据有效性中的选项来选择，也可以录入“25A”、“15A”这样的关键字；

3、所有的条件都是 or 关系，也就是说 三个类别共15个单元格，只要有任意行与 sheet1 中的源数据存在 “包含” 的关系，就算找到了；
     注意是“包含”，不是“等于”，比如 “25A”，规格中只要任意行包含有 “25A” 即判断为查到；

davidshi

爱疯 发表于 2020-7-20 17:12
是这样吗

你好，需要VBA程序，查询结果应该是:

编码	名称	规格型号
CB01000100N0	R-TEE	SUS316L EP-25A*15A-5S--BW
CB01000254N0	R-TEE	SUS316L EP-125A*15A-5S--BW
CB02000083N0	R-TEE	SUS316L BA-25A*15A-5S--BW

砂海

对口工具: "正则表达式"

爱疯

满足条件的记录，只有4楼给出的3个？

davidshi

爱疯 发表于 2020-7-20 17:59
满足条件的记录，只有4楼给出的3个？

条件1：名称允许两个，逻辑是or；
条件2：材质和规格是and，三个条件全满足的结果
条件3：条件1和条件2 and关系

davidshi

看来这次没有高手帮忙了，弄了一天，总算写出来了，也不复杂，供大家参考。
Sub 物料编码检索()
Application.ScreenUpdating = False
Dim arrwl()
Dim arrwlbm2()
Dim num1%, c1$, c2$, c3$, c4$, c5$, hs%
num1 = Sheet2.[a100000].End(3).Row
ReDim arrwl(1 To num1, 1 To 3)
ReDim arrwlbm2(1 To 500)
Sheet1.Range("a5:a500").ClearContents
c1 = Worksheets("检索").Range("B4"): c2 = Worksheets("检索").Range("C4"): c3 = Worksheets("检索").Range("D4"): c4 = Worksheets("检索").Range("E4"): c5 = Worksheets("检索").Range("F4")
With Sheet2
For i = 1 To num1
arrwl(i, 1) = Worksheets("Sheet1").Cells(i, "A")
arrwl(i, 2) = Worksheets("Sheet1").Cells(i, "I")
arrwl(i, 3) = Worksheets("Sheet1").Cells(i, "J")

If c2 <> "" Then
  If ((InStr(1, arrwl(i, 2), c1, 1) > 0) Or (InStr(1, arrwl(i, 2), c2, 1) > 0)) Then '不区分大小写格式 Instr(1,"pPf**f","PP",1) 结果返回1
       If ((InStr(1, arrwl(i, 3), c3, 1) > 0) And (InStr(1, arrwl(i, 3), c4, 1) > 0) And (InStr(1, arrwl(i, 3), c5, 1) > 0)) Then
       hs = hs + 1
       arrwlbm2(hs) = arrwl(i, 1)
    End If
    End If
  ElseIf (InStr(1, arrwl(i, 2), c1, 1) > 0) Then
   If ((InStr(1, arrwl(i, 3), c3, 1) > 0) And (InStr(1, arrwl(i, 3), c4, 1) > 0) And (InStr(1, arrwl(i, 3), c5, 1) > 0)) Then
       hs = hs + 1
       arrwlbm2(hs) = arrwl(i, 1)
    End If
    End If
Next i
End With


For k = 1 To hs

Sheet1.Cells(4 + k, 1) = arrwlbm2(k)
Next k

Application.ScreenUpdating = True
End Sub