[已解决]修改提取代码

c888

窗体数据提取（翻页）.rar (15.15 KB, 下载次数: 10)

2013-12-5 12:04 上传

点击文件名下载附件
谢谢！

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-12-5 13:03

1. Private Sub ComboBox1_Change()
   
2.     CommandButton1.Enabled = False
   
3.     For i = 1 To 30
   
4.         Controls("Label" & i).Caption = ""
   
5.     Next
   
6.     Set d = CreateObject("scripting.dictionary")
   
7.     With Sheets("3")
   
8.         HX = .Range("a65536").End(xlUp).Row
   
9.         arr = .Range("a2:c" & HX)
   
10.     End With
    
11.     If b Then Exit Sub
    
12.     n = 0
    
13.     For i = 1 To UBound(arr)
    
14.         If arr(i, 3) = ComboBox1.Value Then
    
15.             n = n + 1
    
16.             ReDim Preserve arr2(1 To 3, 1 To n)
    
17.             For j = 1 To 3
    
18.                 arr2(j, n) = arr(i, j)
    
19.             Next
    
20.         End If
    
21.     Next
    
22.     If n >= 10 Then CommandButton1.Enabled = True
    
23.     n = 1
    
24.     cyj
    
25. End Sub
    
26. 
    
27. Private Sub CommandButton1_Click()
    
28.     For i = 1 To 30
    
29.         Controls("Label" & i).Caption = ""
    
30.     Next
    
31.     If n > UBound(arr2, 2) Then n = 1
    
32.     cyj
    
33. End Sub
    
34. 
    
35. Private Sub UserForm_Initialize()
    
36.     Set d = CreateObject("scripting.dictionary")
    
37.     With Sheets("3")
    
38.         HX = .Range("a65536").End(xlUp).Row
    
39.         arr = .Range("a2:c" & HX)
    
40.     End With
    
41.     For x = 1 To UBound(arr)
    
42.         If Not d.exists(arr(x, 3)) Then d.Add arr(x, 3), ""
    
43.     Next
    
44.     Me.ComboBox1.Clear
    
45.     Me.ComboBox1.List = d.keys
    
46. End Sub
    
47. 
    
48. Sub cyj()
    
49.     Do Until k = 10 Or n > UBound(arr2, 2)
    
50.         k = k + 1
    
51.         Controls("Label" & k).Caption = arr2(1, n)
    
52.         Controls("Label" & k + 10).Caption = arr2(2, n)
    
53.         Controls("Label" & k + 20).Caption = arr2(3, n)
    
54.         n = n + 1
    
55.     Loop
    
56. 
    
57. End Sub
    

复制代码

跳转到最佳答案楼层

hwc2ycy

1. Private Sub ComboBox1_Change()
   
2.     CommandButton1.Enabled = False
   
3.     For i = 1 To 30
   
4.         Controls("Label" & i).Caption = ""
   
5.     Next
   
6.     Set d = CreateObject("scripting.dictionary")
   
7.     With Sheets("3")
   
8.         HX = .Range("a65536").End(xlUp).Row
   
9.         arr = .Range("a2:c" & HX)
   
10.     End With
    
11.     If b Then Exit Sub
    
12.     n = 0
    
13.     For i = 1 To UBound(arr)
    
14.         If arr(i, 3) = ComboBox1.Value Then
    
15.             n = n + 1
    
16.             ReDim Preserve arr2(1 To 3, 1 To n)
    
17.             For j = 1 To 3
    
18.                 arr2(j, n) = arr(i, j)
    
19.             Next
    
20.         End If
    
21.     Next
    
22.     If n >= 10 Then CommandButton1.Enabled = True
    
23.     n = 1
    
24.     cyj
    
25. End Sub
    
26. 
    
27. Private Sub CommandButton1_Click()
    
28.     For i = 1 To 30
    
29.         Controls("Label" & i).Caption = ""
    
30.     Next
    
31.     If n > UBound(arr2, 2) Then n = 1
    
32.     cyj
    
33. End Sub
    
34. 
    
35. Private Sub UserForm_Initialize()
    
36.     Set d = CreateObject("scripting.dictionary")
    
37.     With Sheets("3")
    
38.         HX = .Range("a65536").End(xlUp).Row
    
39.         arr = .Range("a2:c" & HX)
    
40.     End With
    
41.     For x = 1 To UBound(arr)
    
42.         If Not d.exists(arr(x, 3)) Then d.Add arr(x, 3), ""
    
43.     Next
    
44.     Me.ComboBox1.Clear
    
45.     Me.ComboBox1.List = d.keys
    
46. End Sub
    
47. 
    
48. Sub cyj()
    
49.     Do Until k = 10 Or n > UBound(arr2, 2)
    
50.         k = k + 1
    
51.         Controls("Label" & k).Caption = arr2(1, n)
    
52.         Controls("Label" & k + 10).Caption = arr2(2, n)
    
53.         Controls("Label" & k + 20).Caption = arr2(3, n)
    
54.         n = n + 1
    
55.     Loop
    
56. 
    
57. End Sub
    

复制代码

hwc2ycy

具体改哪我忘了，楼主自己测试下吧。

hwc2ycy

1. Private Sub CommandButton1_Click()
   
2.     For i = 1 To 30
   
3.         Controls("Label" & i).Caption = ""
   
4.     Next
   
5.     If n > UBound(arr2, 2) Then n = 1
   
6.     cyj
   
7. End Sub

复制代码

就改了一句 ：   If n= > UBound(arr2, 2) Then n = 1，这是你原来的。

c888

hwc2ycy 发表于 2013-12-5 13:04
具体改哪我忘了，楼主自己测试下吧。

If n >= UBound(arr2, 2) Then n = 1 改为 If n > UBound(arr2, 2) Then n = 1谢谢！