[已解决]求助 多条记录能否实现逐一显示呢？

hubinhb

最近做了一个查询窗口 有些时候会出现符合条件的多条记录？能不能实现记录的逐条显示呢？
麻烦高手解惑！ 见附件
示例.rar (19.41 KB, 下载次数: 10)

2011-11-30 11:03 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

liuguansky

2011-11-30 11:38

完善几 小细节：

1. 
   
2. Private Sub CommandButton1_Click()
   
3.     If j > 1 Then
   
4.         j = j - 1
   
5.         TextBox2.Text = Arrk(1, j)
   
6.         TextBox3.Text = Arrk(2, j)
   
7.     End If
   
8. End Sub
   
9. Private Sub CommandButton2_Click()
   
10.     If j < k Then
    
11.         j = j + 1
    
12.         TextBox2.Text = Arrk(1, j)
    
13.         TextBox3.Text = Arrk(2, j)
    
14.     End If
    
15. End Sub
    
16. Private Sub CommandButton3_Click()
    
17.     Dim i As Integer, arr
    
18.     Erase Arrk: k = 0: j = 0
    
19.     If TextBox1 = "" Then
    
20.         MsgBox "姓名为必输项！"
    
21.         TextBox1.SetFocus
    
22.     Exit Sub
    
23.     End If
    
24.     With Sheets("模拟数据")
    
25.         arr = .Range("A2:E" & .[a65536].End(3).Row)
    
26.         For i = 1 To UBound(arr)
    
27.             If arr(i, 2) Like "*" & TextBox1.Value & "*" Then
    
28.                 k = k + 1: ReDim Preserve Arrk(1 To 2, 1 To k)
    
29.                 Arrk(1, k) = arr(i, 4)
    
30.                 Arrk(2, k) = arr(i, 5)
    
31.             End If
    
32.         Next
    
33.         If k > 0 Then TextBox2.Text = Arrk(1, 1): TextBox3.Text = Arrk(2, 1): j = 1
    
34.     End With
    
35. End Sub
    
36. Private Sub CommandButton4_Click()
    
37. TextBox1 = ""
    
38. TextBox2 = ""
    
39. TextBox3 = ""
    
40. End Sub
    
41. Private Sub UserForm_Initialize()
    
42.     TextBox1 = ""
    
43.     TextBox2 = ""
    
44.     TextBox3 = ""
    
45.     TextBox1.SetFocus
    
46. End Sub
    

复制代码

见附件效果： 示例.rar (22 KB, 下载次数: 21)

2011-11-30 11:38 上传

点击文件名下载附件

跳转到最佳答案楼层

wuhairong2011

这要会VBA才能  可惜我不会帮不上你

liuguansky

完善几 小细节：

1. 
   
2. Private Sub CommandButton1_Click()
   
3.     If j > 1 Then
   
4.         j = j - 1
   
5.         TextBox2.Text = Arrk(1, j)
   
6.         TextBox3.Text = Arrk(2, j)
   
7.     End If
   
8. End Sub
   
9. Private Sub CommandButton2_Click()
   
10.     If j < k Then
    
11.         j = j + 1
    
12.         TextBox2.Text = Arrk(1, j)
    
13.         TextBox3.Text = Arrk(2, j)
    
14.     End If
    
15. End Sub
    
16. Private Sub CommandButton3_Click()
    
17.     Dim i As Integer, arr
    
18.     Erase Arrk: k = 0: j = 0
    
19.     If TextBox1 = "" Then
    
20.         MsgBox "姓名为必输项！"
    
21.         TextBox1.SetFocus
    
22.     Exit Sub
    
23.     End If
    
24.     With Sheets("模拟数据")
    
25.         arr = .Range("A2:E" & .[a65536].End(3).Row)
    
26.         For i = 1 To UBound(arr)
    
27.             If arr(i, 2) Like "*" & TextBox1.Value & "*" Then
    
28.                 k = k + 1: ReDim Preserve Arrk(1 To 2, 1 To k)
    
29.                 Arrk(1, k) = arr(i, 4)
    
30.                 Arrk(2, k) = arr(i, 5)
    
31.             End If
    
32.         Next
    
33.         If k > 0 Then TextBox2.Text = Arrk(1, 1): TextBox3.Text = Arrk(2, 1): j = 1
    
34.     End With
    
35. End Sub
    
36. Private Sub CommandButton4_Click()
    
37. TextBox1 = ""
    
38. TextBox2 = ""
    
39. TextBox3 = ""
    
40. End Sub
    
41. Private Sub UserForm_Initialize()
    
42.     TextBox1 = ""
    
43.     TextBox2 = ""
    
44.     TextBox3 = ""
    
45.     TextBox1.SetFocus
    
46. End Sub
    

复制代码

见附件效果： 示例.rar (22 KB, 下载次数: 21)

2011-11-30 11:38 上传

点击文件名下载附件

lry2003

高难度动作！咱家不会啦

hubinhb

多谢指导了 学习了