求助各位老师，VBA查询窗口查询+引用功能

zxh880703

求助各位老师帮帮忙，我想做一个查询窗口，主要功能就是通过查询窗口可以在原材料耗用表中模糊查询产品明细表里面，产品所对应的“物料代码”，然后再将查询到的物料代码通过点击填入到“物料代码”单元格中。这个功能要怎么实现呀，求助各位大佬了。

fyure

窗体也不画一个，别人哪知道你要做成啥样

hzruziniu

成本报表模板.rar (454.18 KB, 下载次数: 123)

2018-12-27 13:02 上传

点击文件名下载附件

用ListView1控件给你设置一个
单击B列弹出窗体
在弹出的窗体中单击ListView1列表录入到工作表三列
在TextBox1中输入任何关健词进行模糊筛选查找

zxh880703

fyure 发表于 2018-12-27 08:46
窗体也不画一个，别人哪知道你要做成啥样

老师，就是想要做成这样的，麻烦您了。

zxh880703

hzruziniu 发表于 2018-12-27 13:08
用ListView1控件给你设置一个
单击B列弹出窗体
在弹出的窗体中单击ListView1列表录入到工作表三列

谢谢老师了，嗯，就是我可以不可以做成这样的一个点选按钮，然后我想要选择的时候就选择，您的这个就是我只要一点单元格他就会出来，有时候可能不会需要，麻烦您了老师。非常感谢。

hzruziniu

1. Option Explicit
   
2. Dim Sht1 As Worksheet, Myr&, arr, i&
   
3. Dim Itm As Object 'Dim ITM As ListItem
   
4. 
   
5. '==============退出
   
6. Private Sub Label27_Click()
   
7.     Unload Me
   
8. End Sub
   
9. 
   
10. '==============删除
    
11. Private Sub Label11_Click()
    
12.     Dim i As Long
    
13.     i = [b10000].End(xlUp).Row
    
14.     Range("b" & i & ":e" & i).ClearContents
    
15.     MsgBox "删除成功!"
    
16. End Sub
    
17. 
    
18. '==============录入
    
19. Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
    
20.     Dim h&, y&, r&
    
21.     On Error Resume Next
    
22.     With ListView1
    
23.         h = Range("B65536").End(3).Row + 1
    
24.         y = ActiveCell.Row  '选中的活动单元格行号
    
25.         r = .SelectedItem.Index
    
26.         If OptionButton1.Value Then
    
27.            ' r = .SelectedItem.Index
    
28.             [B65536].End(3).Offset(1, 0) = 1 * .ListItems.Item(r)
    
29.             For i = 1 To 3
    
30.                 [B65536].End(3).Offset(0, i) = .ListItems(r).SubItems(i)
    
31.             Next
    
32.         Else
    
33.             Cells(y, 2).Offset(0, 0) = 1 * .ListItems.Item(r)
    
34.             For i = 1 To 3
    
35.                 Cells(y, 2).Offset(0, i) = .ListItems(r).SubItems(i)
    
36.             Next
    
37.         End If
    
38.         Unload Me
    
39.     End With
    
40. End Sub
    
41. 
    
42. '=================模糊查找生成列表
    
43. Private Sub TextBox1_Change()
    
44.     Dim s As String, j&
    
45.     Call zb
    
46.     If TextBox1.Value <> "" Then
    
47.         s = TextBox1.Text
    
48.         For i = 1 To UBound(arr)
    
49.             For j = 1 To 4
    
50.                 If arr(i, j) Like "*" & s & "*" Then
    
51.                     Set Itm = ListView1.ListItems.Add()
    
52.                     Itm.Text = arr(i, 1)
    
53.                     Itm.SubItems(1) = arr(i, 2)
    
54.                     Itm.SubItems(2) = arr(i, 3)
    
55.                     Itm.SubItems(3) = arr(i, 4)
    
56.                 End If
    
57.             Next
    
58.         Next
    
59.     Else
    
60.         For i = 1 To UBound(arr)
    
61.             Set Itm = ListView1.ListItems.Add
    
62.             Itm.Text = arr(i, 1)
    
63.             Itm.SubItems(1) = arr(i, 2)
    
64.             Itm.SubItems(2) = arr(i, 3)
    
65.             Itm.SubItems(3) = arr(i, 4)
    
66.         Next
    
67.     End If
    
68.     Label1.Caption = "共找到 " & ListView1.ListItems.Count & " 条记录"
    
69. End Sub
    
70. 
    
71. '==============初始化
    
72. Private Sub UserForm_Initialize()
    
73.     Dim k, d
    
74.     Set d = CreateObject("Scripting.Dictionary")
    
75.     Set Sht1 = Worksheets("产品明细表")
    
76.     Myr = Sht1.[B65536].End(xlUp).Row
    
77.     arr = Sht1.Range("b3:e" & Myr)
    
78.     Call zb
    
79.     Call tgse 'zb
    
80.     For i = 1 To UBound(arr)
    
81.         d(arr(i, 2)) = ""
    
82.     Next
    
83.     k = d.keys
    
84.     With Me.ListBox1
    
85.         .ColumnCount = 1
    
86.         .ColumnWidths = "50"
    
87.       '  .ColumnHeads = True
    
88.         .BoundColumn = 1
    
89.         .List = k
    
90.     End With
    
91.     OptionButton1.Value = True
    
92.     Set d = Nothing
    
93. End Sub
    
94. 
    
95. '==============设置表格式填表头项目
    
96. Sub zb()
    
97. With ListView1
    
98.     .ColumnHeaders.Clear
    
99.     .ListItems.Clear
    
100.     .ColumnHeaders.Add , , "产品代码", Width / 6
     
101.     .ColumnHeaders.Add , , "产品类别", Width / 6
     
102.     .ColumnHeaders.Add , , "产品名称", Width / 7
     
103.     .ColumnHeaders.Add , , "产品型号", Width / 7
     
104.     .View = lvwReport        '   listivew的显示格式为报表格式
     
105.     .FullRowSelect = True    '   允许整行选中
     
106.     .Gridlines = True        '   显示网格线
     
107. End With
     
108. End Sub
     
109. 
     
110. '==============填表
     
111. Sub tgse()
     
112.     For i = 1 To UBound(arr)
     
113.         If TextBox1.Text <> "" And TextBox1.Text = arr(i, 2) Then
     
114.             Set Itm = ListView1.ListItems.Add
     
115.             Itm.Text = arr(i, 1)
     
116.             Itm.SubItems(1) = arr(i, 2)
     
117.             Itm.SubItems(2) = arr(i, 3)
     
118.             Itm.SubItems(3) = arr(i, 4)
     
119.         Else
     
120.             Set Itm = ListView1.ListItems.Add
     
121.             Itm.Text = arr(i, 1)
     
122.             Itm.SubItems(1) = arr(i, 2)
     
123.             Itm.SubItems(2) = arr(i, 3)
     
124.             Itm.SubItems(3) = arr(i, 4)
     
125.         End If
     
126.     Next i
     
127. End Sub
     
128. 
     
129. '===================分类查找生成列表
     
130. Private Sub ListBox1_Click()
     
131.      TextBox1.Text = ListBox1.List(ListBox1.ListIndex, 0)
     
132.      Call zb
     
133.      For i = 1 To UBound(arr)
     
134.          If TextBox1.Text = arr(i, 2) Then
     
135.             Set Itm = ListView1.ListItems.Add
     
136.             Itm.Text = arr(i, 1)
     
137.             Itm.SubItems(1) = arr(i, 2)
     
138.             Itm.SubItems(2) = arr(i, 3)
     
139.             Itm.SubItems(2) = arr(i, 4)
     
140.         End If
     
141.      Next i
     
142. End Sub
     
143. 
     

复制代码

hzruziniu

成本报表模板 .rar (459.37 KB, 下载次数: 140)

2018-12-28 14:08 上传

点击文件名下载附件

按你的要求把文件发给你，你的文件中没有产品类别，按你的图示加了一列产品类别
1、打开窗体自动生成全部产品的列表，并在左侧生成产品不重复值列表
2、点击左侧的产品类别右侧窗口筛选所选该类型的产品
3、在右上方的文本内输入任何列中的字符模糊查找生成列表
4、录入分二种类型：点选录入，则按下方录入
    点选修改，则录入到所选中的行

zxh880703

hzruziniu 发表于 2018-12-28 14:17
按你的要求把文件发给你，你的文件中没有产品类别，按你的图示加了一列产品类别
1、打开窗体自动生成全部 ...

拜谢老师啦，非常感谢

民扬

hzruziniu 发表于 2018-12-28 14:17
按你的要求把文件发给你，你的文件中没有产品类别，按你的图示加了一列产品类别
1、打开窗体自动生成全部 ...

真的，非常好，收藏了。

hzruziniu

zxh880703 发表于 2018-12-28 14:22
拜谢老师啦，非常感谢

成本报表模板 (version 1).rar (469.25 KB, 下载次数: 259)

2018-12-29 15:17 上传

点击文件名下载附件

增加了新的产品名称录入窗体