[已解决]下标越界

张雄友

下标越界未解决。

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2014-3-7 09:02

1. Sub RctDataRnd()
   
2.     Dim rw&, cl&, i&, j&, ii&, jj&, m&, n&, r&, t, k&, YY, crr, rng As Range, n2&
   
3.     Set rng = Application.InputBox("请选择源区域", "温馨提示如A2：D21", , , , , , 8)
   
4.     If rng Is Nothing Then Exit Sub
   
5.     arr = rng
   
6.     m = Application.CountA(rng)
   
7.     rw = UBound(arr) - 1: cl = UBound(arr, 2)
   
8.     n = Int(Val(InputBox("How many ?" & vbCr & " [1 to " & m & "]", "Get Rand", 12)))    '抽取个数n
   
9.     If n <= 0 Or n > m Then MsgBox "HeadCounts is not correct.": Exit Sub
   
10.     n2 = n
    
11.     Randomize
    
12.     ReDim jg$(1 To n2, 1 To 1)
    
13.     For i = 1 To rw
    
14.         For j = 1 To cl
    
15.             Do
    
16.                 r = Int(Rnd() * ((rw - i + 1) * cl - j + 1)) + (i - 1) * cl + j - 1
    
17.                 ii = Int(r / cl) + 1: jj = r Mod cl + 1
    
18.                 t = arr(ii, jj)
    
19.                 If t <> "" Then
    
20.                     arr(ii, jj) = arr(i, j): arr(i, j) = t
    
21.                     jg(n, 1) = t
    
22.                     n = n - 1: If n = 0 Then Exit For Else Exit Do
    
23.                 End If
    
24.             Loop
    
25.         Next
    
26.         If n = 0 Then
    
27.             For j = j + 1 To cl
    
28.                 arr(i, j) = ""
    
29.             Next
    
30.             Exit For
    
31.         End If
    
32.     Next
    
33. 
    
34. 
    
35.     On Error Resume Next
    
36.     If n2 < 65536 Then
    
37.         YY = Val(InputBox("请输入要生成的列数?", ""))
    
38.         r = n2 \ YY
    
39.         If r * YY < n2 Then r = r + 1
    
40.         ReDim crr(1 To r, 1 To YY)
    
41. 
    
42.         For i = 1 To r
    
43.             For j = 1 To YY
    
44.                 crr(i, j) = jg((i - 1) * YY + j, 1)
    
45.             Next j
    
46.         Next i
    
47.         Set rng = Application.InputBox("请选择存放区域(单个单元格即可)", "VBA", , , , , , 8)
    
48.         rng.CurrentRegion.ClearContents
    
49.         rng.Resize(r, YY) = crr
    
50.     End If
    
51. End Sub

复制代码

改成这样，数据能出来，不知道合不合要求。
另外，你前面那一段数据换位的，不知道是啥意思。

跳转到最佳答案楼层

zgwei050

ReDim jg$(1 to n, 1 To 1) 出现错误，程序运行到这里时n=0
且jg前面也没有出现过，现在jg又进行了ReDim，必然是空数组，后面运算crr(i, j) = jg((i - 1) * YY + j, j) 的结果还是空的，什么也没有，可能改为crr(i, j) =arr((i - 1) * YY + j, j) 还有指望一些。

张雄友

zgwei050 发表于 2014-3-6 22:33
ReDim jg$(1 to n, 1 To 1) 出现错误，程序运行到这里时n=0
且jg前面也没有出现过，现在jg又进行了ReDim， ...

一天没搞明白

hwc2ycy

这个错误已经很明显了，前面的双重循环都不用看，就在循环结束后这一行下个断点，就发现问题了。

张雄友

hwc2ycy 发表于 2014-3-6 22:45
这个错误已经很明显了，前面的双重循环都不用看，就在循环结束后这一行下个断点，就发现问题了。

怎么改好？

hwc2ycy

jg数组自始就没有赋过值，输出没有意义。

hwc2ycy

1. Sub RctDataRnd()    '输出列数修改,输出的列数可以用 inputbox 来选择,假如用  inputbox 来选择输出，可以是1 列，5列，......用户可以根据需要决定，人性化。
   
2.     Dim rw&, cl&, i&, j&, ii&, jj&, m&, n&, r&, t, k&, YY, crr, rng As Range, n2%
   
3.     Set rng = Application.InputBox("请选择源区域", "温馨提示如A2：D21", , , , , , 8)
   
4.     If rng Is Nothing Then Exit Sub
   
5.     arr = rng
   
6.     m = Application.CountA(rng)
   
7.     rw = UBound(arr) - 1: cl = UBound(arr, 2)
   
8.     n = Int(Val(InputBox("How many ?" & vbCr & " [1 to " & m & "]", "Get Rand", 12)))    '抽取个数n
   
9.     If n <= 0 Or n > m Then MsgBox "HeadCounts is not correct.": Exit Sub
   
10.     n2 = n
    
11.     Randomize
    
12.     For i = 1 To rw
    
13.         For j = 1 To cl
    
14.             Do
    
15.                 r = Int(Rnd() * ((rw - i + 1) * cl - j + 1)) + (i - 1) * cl + j - 1
    
16.                 ii = Int(r / cl) + 1: jj = r Mod cl + 1
    
17.                 t = arr(ii, jj)
    
18.                 If t <> "" Then
    
19.                     arr(ii, jj) = arr(i, j): arr(i, j) = t
    
20.                     n = n - 1: If n = 0 Then Exit For Else Exit Do
    
21.                 End If
    
22.             Loop
    
23.         Next
    
24.         If n = 0 Then
    
25.             For j = j + 1 To cl
    
26.                 arr(i, j) = ""
    
27.             Next
    
28.             Exit For
    
29.         End If
    
30.     Next
    
31.     '[a1].Offset(1, cl + 1).Resize(i, cl) = arr '输出列数？？？？？
    
32.     ReDim jg$(1 To n2, 1 To 1)
    
33. 
    
34.     On Error Resume Next
    
35.     If n2 < 65536 Then
    
36.         YY = Val(InputBox("请输入要生成的列数?", ""))
    
37.         r = n2 \ YY
    
38.         If r * YY < n2 Then r = r + 1
    
39.         ReDim crr(1 To r, 1 To YY)
    
40. 
    
41.         For i = 1 To r
    
42.             For j = 1 To YY
    
43.                 crr(i, j) = jg((i - 1) * YY + j, 1)
    
44.             Next j
    
45.         Next i
    
46.         Set rng = Application.InputBox("请选择存放区域(单个单元格即可)", "VBA", , , , , , 8)
    
47.         rng.CurrentRegion.ClearContents
    
48.         rng.Resize(r, YY) = crr
    
49.     End If
    
50. End Sub

复制代码

后面的jg数组赋值的问题你自己想下，是怎么回事。

张雄友

hwc2ycy 发表于 2014-3-6 22:59
后面的jg数组赋值的问题你自己想下，是怎么回事。

没有数据出来的？

hwc2ycy

张雄友 发表于 2014-3-6 23:05
没有数据出来的？

你在空的数组里取值，然后写入单元格，单元格相当于没写一样，全是空的嘛。

hwc2ycy

1. Sub RctDataRnd()
   
2.     Dim rw&, cl&, i&, j&, ii&, jj&, m&, n&, r&, t, k&, YY, crr, rng As Range, n2&
   
3.     Set rng = Application.InputBox("请选择源区域", "温馨提示如A2：D21", , , , , , 8)
   
4.     If rng Is Nothing Then Exit Sub
   
5.     arr = rng
   
6.     m = Application.CountA(rng)
   
7.     rw = UBound(arr) - 1: cl = UBound(arr, 2)
   
8.     n = Int(Val(InputBox("How many ?" & vbCr & " [1 to " & m & "]", "Get Rand", 12)))    '抽取个数n
   
9.     If n <= 0 Or n > m Then MsgBox "HeadCounts is not correct.": Exit Sub
   
10.     n2 = n
    
11.     Randomize
    
12.     ReDim jg$(1 To n2, 1 To 1)
    
13.     For i = 1 To rw
    
14.         For j = 1 To cl
    
15.             Do
    
16.                 r = Int(Rnd() * ((rw - i + 1) * cl - j + 1)) + (i - 1) * cl + j - 1
    
17.                 ii = Int(r / cl) + 1: jj = r Mod cl + 1
    
18.                 t = arr(ii, jj)
    
19.                 If t <> "" Then
    
20.                     arr(ii, jj) = arr(i, j): arr(i, j) = t
    
21.                     jg(n, 1) = t
    
22.                     n = n - 1: If n = 0 Then Exit For Else Exit Do
    
23.                 End If
    
24.             Loop
    
25.         Next
    
26.         If n = 0 Then
    
27.             For j = j + 1 To cl
    
28.                 arr(i, j) = ""
    
29.             Next
    
30.             Exit For
    
31.         End If
    
32.     Next
    
33. 
    
34. 
    
35.     On Error Resume Next
    
36.     If n2 < 65536 Then
    
37.         YY = Val(InputBox("请输入要生成的列数?", ""))
    
38.         r = n2 \ YY
    
39.         If r * YY < n2 Then r = r + 1
    
40.         ReDim crr(1 To r, 1 To YY)
    
41. 
    
42.         For i = 1 To r
    
43.             For j = 1 To YY
    
44.                 crr(i, j) = jg((i - 1) * YY + j, 1)
    
45.             Next j
    
46.         Next i
    
47.         Set rng = Application.InputBox("请选择存放区域(单个单元格即可)", "VBA", , , , , , 8)
    
48.         rng.CurrentRegion.ClearContents
    
49.         rng.Resize(r, YY) = crr
    
50.     End If
    
51. End Sub

复制代码

改成这样，数据能出来，不知道合不合要求。
另外，你前面那一段数据换位的，不知道是啥意思。