[已解决]Excel 2003 VBA 问题

spp0063

grf1973 发表于 2016-11-11 16:37
请看附件。

grf1973 你好,
打开变成乱码,看不出,我的是繁体中文版本

grf1973

是的。我打开你的也是乱码。所以帖了代码。

spp0063

grf1973 发表于 2016-11-14 10:24
是的。我打开你的也是乱码。所以帖了代码。

你好,
不好意思,再请教一个问题, 问题如下
If LotNo Like "*-" & x & "-*" Then
抓取单一批号是没有问题(批号只有DW01-16110726-1122), 但是我的批号有可能为附图的批号(DW01-16110726-1122 或DW0R-16110726-1122),若x输入相同批号是否可分别抓取到DW01-16110726-1122与DW0R-16110726-1122,请问该如何修改,谢谢.

grf1973

(DW01-16110726-1122 或DW0R-16110726-1122)
你到底想抓取哪个？有什么规律？
If LotNo Like "*-" & x & "-*" Then 表示 可抓取含 “-16110726-”的所有批号。

spp0063

grf1973 发表于 2016-11-14 16:51
(DW01-16110726-1122 或DW0R-16110726-1122)
你到底想抓取哪个？有什么规律？
If LotNo Like "*-" & x &  ...

你好,
DW01-16110726-1122 或DW0R-16110726-1122 兩種批號都有可能被抓取, 規律性都是DW0開頭(DW01-16110726-1122 或DW0R-16110726-1122),有没有可以输入1-16110726带出相对应的数值,输入R-16110726带出相对应的数值,是否有这种写法?
不好意思, 再次麻烦你,谢谢.

grf1973

要不干脆搞个下拉框动态提示？随着输入内容逐步缩小符合条件的批号范围。

spp0063

grf1973 发表于 2016-11-15 13:27
要不干脆搞个下拉框动态提示？随着输入内容逐步缩小符合条件的批号范围。

你好,
下拉框动态提示这是指什么意思? 是否有样本可供参考, 谢谢

grf1973

做了个窗体，帖代码如下。
按“搜寻资料”窗体自动运行。

1. Dim brr()
   
2. 
   
3. Private Sub CommandButton1_Click()
   
4.     crr = Me.ListBox1.List
   
5.     For i = 0 To Me.ListBox1.ListCount - 1
   
6.         If Me.ListBox1.Selected(i) = True Then xstr = xstr & "," & Me.ListBox1.List(i)
   
7.     Next
   
8.     xstr = Mid(xstr, 2)
   
9.     If Len(xstr) Then Call Sel(xstr) Else MsgBox "Please Selcet At Least One LotNo"
   
10.     Unload Me
    
11. End Sub
    
12. 
    
13. Private Sub CommandButton2_Click()
    
14.     Unload Me
    
15. End Sub
    
16. 
    
17. Private Sub TextBox1_Change()           '文本框改变引发下拉框列表改变
    
18.     Dim str$, i%, j%, k%
    
19.     str = UCase(Trim(TextBox1))
    
20.     If Len(str) = 0 Then
    
21.         ListBox1.List = brr
    
22.         Exit Sub
    
23.     Else
    
24.         ListBox1.Clear
    
25.         For j = 1 To UBound(brr)
    
26.             kh = brr(j)
    
27.             If Len(kh) > 0 Then
    
28.                 If kh Like "*" & str & "*" Then
    
29.                     i = i + 1
    
30.                     ListBox1.AddItem brr(j)   '   AddItem 对于单列的列表框或组合框，在列表中添加一项。对于多列的列表框或组合框，在列表中添加一行。
    
31.                 End If
    
32.             End If
    
33.         Next
    
34.     End If
    
35. End Sub
    
36. '
    
37. Private Sub UserForm_Initialize()
    
38.     Set d = CreateObject("scripting.dictionary")
    
39.     With Sheets(1)
    
40.         arr = .Range("a6:a" & .[a65536].End(3).Row)
    
41.         For i = 1 To UBound(arr)
    
42.             If Len(arr(i, 1)) Then d(arr(i, 1)) = ""
    
43.         Next
    
44.         brr = d.keys
    
45.         Me.ListBox1.List = brr
    
46.     End With
    
47. End Sub
    
48. 
    
49. Private Sub Sel(xstr)
    
50.     Dim i, j, jj, k, x, LotNo
    
51.     Dim ToRange As Range
    
52.     Dim tmpArr(), n(), arr
    
53.     With Worksheets(1)   '读入数据源
    
54.         arr = .Range("a1:av" & .[a65536].End(3).Row)
    
55.     End With
    
56.     With ActiveSheet
    
57.         Set ToRange = .Range("F4:J18")
    
58.         ReDim tmpArr(1 To ToRange.Rows.Count, 1 To 5)
    
59.         ReDim n(1 To ToRange.Rows.Count)     '数组n记录每组数的记录位置
    
60.         ToRange.ClearContents: .[I2] = ""
    
61.         xrr = Split(xstr, ",")
    
62.         For i = 6 To UBound(arr)
    
63.             LotNo = arr(i, 1)   '批号
    
64.             For Each x In xrr
    
65.                 If LotNo = x Then
    
66.                     .Range("I2") = LotNo    'I2显示为批号（这样vlookup结果就正确了，但当符合条件的有多条记录时，会只显示最后一条记录的批号）
    
67.                     For j = 5 To 47 Step 3    'E列到AU列
    
68.                         k = (j - 2) / 3    '根据源数据的列转换到tmparr的行
    
69.                         For jj = 0 To 2   '每列共3列需录入tmpArr（最后一次2列）
    
70.                             If j + jj <= UBound(arr, 2) Then    '限定边界（最后一次只计算AU--AV列）
    
71.                                 If arr(i, j + jj) <> "" Then     '如果数据源需录入的列非空
    
72.                                     n(k) = n(k) + 1     'tmpArr对应行每组的记录位置+1
    
73.                                     If n(k) <= 5 Then tmpArr(k, n(k)) = arr(i, j + jj)   '源数据保存到记录位置（最多只保存5个）
    
74.                                 End If
    
75.                             End If
    
76.                         Next jj
    
77.                     Next j
    
78.                 End If
    
79.             Next
    
80.         Next i
    
81.         ToRange = tmpArr    '显示结果
    
82.     End With
    
83. End Sub
    

复制代码

grf1973

在文本框里输入内容，下面List会动态更新。点选后按“OK"即可。可多选。

spp0063

grf1973 发表于 2016-11-15 14:51
在文本框里输入内容，下面List会动态更新。点选后按“OK"即可。可多选。

你好,
谢谢你抽空帮我写出这个程式,使用附件测试后,
1. 我尝试建立一个与你相同的表单后,发现你的会有框框可以选择,我的没有,怎么叫出框框选择?