求助！如何用VBA实现多条件横向查询？

mxfx999

各位大神，小弟新手，有一个多条件查询（写入位置横向纵向都有）的表格不知道VBA怎么弄，请帮帮忙！

liulang0808

楼主附件中的编号，OP号，PK号 每个类型都不是没有重复的吧？建议使用find直接查找

mxfx999

liulang0808 发表于 2018-7-5 21:00
楼主附件中的编号，OP号，PK号 每个类型都不是没有重复的吧？建议使用find直接查找

我的意思不是提取字段，我要用 编号，OP号，PK号任意一个号去查找对应列的内容，但不需要整列调用，只需要指定的调出来。

liulang0808

mxfx999 发表于 2018-7-6 18:35
我的意思不是提取字段，我要用 编号，OP号，PK号任意一个号去查找对应列的内容，但不需要整列调用，只需 ...

那么楼主使用find进行查找即可吧

mxfx999

liulang0808 发表于 2018-7-6 18:57
那么楼主使用find进行查找即可吧

版主可以帮忙在附件举个例子吗？谢谢

liulang0808

1. Sub 圆角矩形6_Click()
   
2.     Application.ScreenUpdating = False
   
3.     For j = 2 To 6 Step 2
   
4.         If Len(Cells(j, 2)) > 0 Then
   
5.             Set Rng = Sheets("档案").Rows(j / 2).Find(Cells(1, j).Value, lookat:=xlWhole)
   
6.             If Not Rng Is Nothing Then
   
7.                 r = Rng.Column
   
8.                 With Sheets("档案")
   
9.                     Cells(7, 1) = .Cells(1, r)
   
10.                     Cells(7, 2) = .Cells(2, r)
    
11.                     Cells(7, 3) = .Cells(3, r)
    
12.                     Cells(7, 4) = .Cells(5, r)
    
13.                 End With
    
14.             Else
    
15.                 MsgBox "输入的" & Cells(1, j - 1) & "不存在"
    
16.             End If
    
17.             Exit For
    
18.         End If
    
19.     Next j
    
20.     Application.ScreenUpdating = True
    
21. End Sub
    

复制代码

liulang0808

附件内容供参考，不知道理解的对不对

mxfx999

liulang0808 发表于 2018-7-6 20:22
附件内容供参考，不知道理解的对不对

PK号 可以查找但 编号 和OP号不行。麻烦帮忙看看哪里出问题了。

duquancai

mxfx999 发表于 2018-7-6 18:35
我的意思不是提取字段，我要用 编号，OP号，PK号任意一个号去查找对应列的内容，但不需要整列调用，只需 ...

用SQL吧！曾经回帖写过，自己找找看！

liulang0808

1. Sub 圆角矩形6_Click()
   
2.     Application.ScreenUpdating = False
   
3.     For j = 2 To 6 Step 2
   
4.         If Len(Cells(1, j)) > 0 Then
   
5.             Set Rng = Sheets("档案").Rows(j / 2).Find(Cells(1, j).Value, lookat:=xlWhole)
   
6.             If Not Rng Is Nothing Then
   
7.                 r = Rng.Column
   
8.                 With Sheets("档案")
   
9.                     Cells(7, 1) = .Cells(1, r)
   
10.                     Cells(7, 2) = .Cells(2, r)
    
11.                     Cells(7, 3) = .Cells(3, r)
    
12.                     Cells(7, 4) = .Cells(5, r)
    
13.                 End With
    
14.             Else
    
15.                 MsgBox "输入的" & Cells(1, j - 1) & "不存在"
    
16.             End If
    
17.             Exit For
    
18.         End If
    
19.     Next j
    
20.     Application.ScreenUpdating = True
    
21. End Sub
    

复制代码