[已解决]请老师修改代码

ymq123

请老师修改代码。谢谢

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-3-19 16:38

1. Private Sub 组合_Click()
   
2. 
   
3.     Dim Arr, i&, r%, s(), j&, i1&, i2&, i3&, i4&, i5&, x$, x3%
   
4.     Dim d, k, Brr
   
5.     Range("a4:ce14") = ""
   
6.     Set d = CreateObject("Scripting.Dictionary")
   
7. 
   
8.     For x3 = 0 To 3
   
9.         Arr = Range(Cells(1, 1 + x3 * 14), Cells(2, 7 + x3 * 14))
   
10.         Debug.Print Range(Cells(1, 1 + x3 * 14), Cells(2, 7 + x3 * 14)).Address(False, False)
    
11.         For i = 1 To UBound(Arr)
    
12. 
    
13.             For j = 1 To UBound(Arr, 2)
    
14. 
    
15.                 If Arr(i, j) <> "" Then
    
16. 
    
17.                     r = r + 1
    
18. 
    
19.                     ReDim Preserve s(1 To r)
    
20. 
    
21.                     s(r) = Arr(i, j)
    
22. 
    
23.                 End If
    
24. 
    
25.             Next
    
26. 
    
27.             If r >= 5 Then
    
28. 
    
29.                 For i1 = 1 To r - 4
    
30. 
    
31.                     For i2 = i1 + 1 To r - 3
    
32. 
    
33.                         For i3 = i2 + 1 To r - 2
    
34. 
    
35.                             For i4 = i3 + 1 To r - 1
    
36. 
    
37.                                 For i5 = i4 + 1 To r
    
38. 
    
39.                                     x = s(i1) & "," & s(i2) & "," & s(i3) & "," & s(i4) & "," & s(i5)
    
40. 
    
41.                                     d(x) = ""
    
42. 
    
43.                                 Next
    
44. 
    
45.                             Next
    
46. 
    
47.                         Next
    
48. 
    
49.                     Next
    
50. 
    
51.                 Next
    
52. 
    
53.             End If
    
54. 
    
55.             r = 0
    
56. 
    
57.         Next
    
58. 
    
59.         k = d.keys
    
60. 
    
61.         ReDim Brr(1 To d.Count, 1 To 7)
    
62. 
    
63.         For i = 0 To UBound(k)
    
64. 
    
65.             aa = Split(k(i), ",")
    
66. 
    
67.             For j = 0 To UBound(aa)
    
68. 
    
69.                 Brr(i + 1, aa(j)) = aa(j)
    
70. 
    
71.             Next
    
72. 
    
73.         Next
    
74. 
    
75.         Cells(4, 1 + x3 * 14).Resize(UBound(Brr), 7) = Brr
    
76.         d.RemoveAll
    
77. 
    
78.     Next x3
    
79. End Sub
    

复制代码

跳转到最佳答案楼层

hwc2ycy

1. Cells(4, 1 + x3 * 14).Resize(UBound(Brr), 7) = Brr
   
2. d.RemoveAll

复制代码

每次得清空字典。

hwc2ycy

1. Private Sub 组合_Click()
   
2. 
   
3.     Dim Arr, i&, r%, s(), j&, i1&, i2&, i3&, i4&, i5&, x$, x3%
   
4.     Dim d, k, Brr
   
5.     Range("a4:ce14") = ""
   
6.     Set d = CreateObject("Scripting.Dictionary")
   
7. 
   
8.     For x3 = 0 To 3
   
9.         Arr = Range(Cells(1, 1 + x3 * 14), Cells(2, 7 + x3 * 14))
   
10.         Debug.Print Range(Cells(1, 1 + x3 * 14), Cells(2, 7 + x3 * 14)).Address(False, False)
    
11.         For i = 1 To UBound(Arr)
    
12. 
    
13.             For j = 1 To UBound(Arr, 2)
    
14. 
    
15.                 If Arr(i, j) <> "" Then
    
16. 
    
17.                     r = r + 1
    
18. 
    
19.                     ReDim Preserve s(1 To r)
    
20. 
    
21.                     s(r) = Arr(i, j)
    
22. 
    
23.                 End If
    
24. 
    
25.             Next
    
26. 
    
27.             If r >= 5 Then
    
28. 
    
29.                 For i1 = 1 To r - 4
    
30. 
    
31.                     For i2 = i1 + 1 To r - 3
    
32. 
    
33.                         For i3 = i2 + 1 To r - 2
    
34. 
    
35.                             For i4 = i3 + 1 To r - 1
    
36. 
    
37.                                 For i5 = i4 + 1 To r
    
38. 
    
39.                                     x = s(i1) & "," & s(i2) & "," & s(i3) & "," & s(i4) & "," & s(i5)
    
40. 
    
41.                                     d(x) = ""
    
42. 
    
43.                                 Next
    
44. 
    
45.                             Next
    
46. 
    
47.                         Next
    
48. 
    
49.                     Next
    
50. 
    
51.                 Next
    
52. 
    
53.             End If
    
54. 
    
55.             r = 0
    
56. 
    
57.         Next
    
58. 
    
59.         k = d.keys
    
60. 
    
61.         ReDim Brr(1 To d.Count, 1 To 7)
    
62. 
    
63.         For i = 0 To UBound(k)
    
64. 
    
65.             aa = Split(k(i), ",")
    
66. 
    
67.             For j = 0 To UBound(aa)
    
68. 
    
69.                 Brr(i + 1, aa(j)) = aa(j)
    
70. 
    
71.             Next
    
72. 
    
73.         Next
    
74. 
    
75.         Cells(4, 1 + x3 * 14).Resize(UBound(Brr), 7) = Brr
    
76.         d.RemoveAll
    
77. 
    
78.     Next x3
    
79. End Sub
    

复制代码

hwc2ycy

1. ReDim Brr(1 To d.Count, 1 To 7)

复制代码

你在这一句设断点，单步后就会发现，后面数组维数不同嘛。