设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 请老师帮助查找代码下标越界原因
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 1647|回复: 8

[已解决]请老师帮助查找代码下标越界原因

[复制链接]
ymq123
发表于 2013-4-17 13:03 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
请老师帮助查找代码ReDim Brr(1 To D.Count, 1 To 10)下标越界原因。谢谢！
最佳答案
月排行榜 / 总排行榜
hwc2ycy
2013-4-17 13:38
  1. Private Sub 组合_Click()
  2.     Dim Arr, i&, r%, S(), j&, i1&, i2&, i3&, i4&, i5&, x$, x3%, y3%
  3.     Dim D, k, Brr()


  6.     Set D = CreateObject("Scripting.Dictionary")
  7.     Arr = Range(Cells(1, 1), Cells(106, 10))
  8.     Debug.Print Range(Cells(1, 1), Cells(106, 10)).Address(False, False)
  9.     For i = 1 To UBound(Arr)
  10.         For j = 1 To UBound(Arr, 2)
  11.             If Val(Arr(i, j)) > 0 Then
  12.                 r = r + 1
  13.                 ReDim Preserve S(1 To r)
  14.                 S(r) = Arr(i, j)
  15.             End If
  16.         Next
  17.         r = 0
  18.         If r >= 5 Then
  19.             For i1 = 1 To r - 4
  20.                 For i2 = i1 + 1 To r - 3
  21.                     For i3 = i2 + 1 To r - 2
  22.                         For i4 = i3 + 1 To r - 1
  23.                             For i5 = i4 + 1 To r
  24.                                 x = S(i1) & "," & S(i2) & "," & S(i3) & "," & S(i4) & "," & S(i5)
  25.                                 D(x) = ""
  26.                             Next
  27.                         Next
  28.                     Next
  29.                 Next
  30.             Next
  31.         End If

  33.     Next
  34.     k = D.keys
  35.     If D.Count > 0 Then
  36.         ReDim Brr(1 To D.Count, 1 To 10)
  37.         For i = 0 To UBound(k)
  38.             aa = Split(k(i), ",")
  39.             For j = 0 To UBound(aa)
  40.                 If aa(j) <> "" Then Brr(i + 1, aa(j)) = aa(j)
  41.             Next
  42.         Next
  43.         Cells(144, 1).Resize(UBound(Brr), 10) = Brr
  44.         'D.RemoveAll
  45.     End If
  46. End Sub
复制代码

下标越界.rar

14.43 KB, 下载次数: 6
excel精英培训的微信平台，每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
hwc2ycy
发表于 2013-4-17 13:37 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
D.COUNT=0，加个判断吧。
回复

使用道具 举报

hwc2ycy
发表于 2013-4-17 13:38 | 显示全部楼层    本楼为最佳答案   
工作中最常用的Excel函数公式，全印在一张鼠标垫上
  1. Private Sub 组合_Click()
  2.     Dim Arr, i&, r%, S(), j&, i1&, i2&, i3&, i4&, i5&, x$, x3%, y3%
  3.     Dim D, k, Brr()


  6.     Set D = CreateObject("Scripting.Dictionary")
  7.     Arr = Range(Cells(1, 1), Cells(106, 10))
  8.     Debug.Print Range(Cells(1, 1), Cells(106, 10)).Address(False, False)
  9.     For i = 1 To UBound(Arr)
  10.         For j = 1 To UBound(Arr, 2)
  11.             If Val(Arr(i, j)) > 0 Then
  12.                 r = r + 1
  13.                 ReDim Preserve S(1 To r)
  14.                 S(r) = Arr(i, j)
  15.             End If
  16.         Next
  17.         r = 0
  18.         If r >= 5 Then
  19.             For i1 = 1 To r - 4
  20.                 For i2 = i1 + 1 To r - 3
  21.                     For i3 = i2 + 1 To r - 2
  22.                         For i4 = i3 + 1 To r - 1
  23.                             For i5 = i4 + 1 To r
  24.                                 x = S(i1) & "," & S(i2) & "," & S(i3) & "," & S(i4) & "," & S(i5)
  25.                                 D(x) = ""
  26.                             Next
  27.                         Next
  28.                     Next
  29.                 Next
  30.             Next
  31.         End If

  33.     Next
  34.     k = D.keys
  35.     If D.Count > 0 Then
  36.         ReDim Brr(1 To D.Count, 1 To 10)
  37.         For i = 0 To UBound(k)
  38.             aa = Split(k(i), ",")
  39.             For j = 0 To UBound(aa)
  40.                 If aa(j) <> "" Then Brr(i + 1, aa(j)) = aa(j)
  41.             Next
  42.         Next
  43.         Cells(144, 1).Resize(UBound(Brr), 10) = Brr
  44.         'D.RemoveAll
  45.     End If
  46. End Sub
复制代码
回复

使用道具 举报

ymq123
 楼主| 发表于 2013-4-17 13:56 | 显示全部楼层
hwc2ycy 发表于 2013-4-17 13:38

你好：代码修改后，点击按钮时不能运行，再麻烦老师。谢谢！
回复

使用道具 举报

hwc2ycy
发表于 2013-4-17 14:17 | 显示全部楼层
我这可以运行嘛，是结果不对还是点了没反应。
因为你的D.COUNT是0，肯定不会出结果的。
回复

使用道具 举报

ymq123
 楼主| 发表于 2013-4-17 14:30 | 显示全部楼层
hwc2ycy 发表于 2013-4-17 14:17
我这可以运行嘛，是结果不对还是点了没反应。
因为你的D.COUNT是0，肯定不会出结果的。

没有反应。谢谢！！！！！！！！！！！！！！！！！！！！
回复

使用道具 举报

hwc2ycy
发表于 2013-4-17 16:43 | 显示全部楼层
  1. Private Sub 组合_Click()
  2.     Dim Arr, i&, r%, S(), j&, i1&, i2&, i3&, i4&, i5&, x$, x3%, y3%
  3.     Dim D, k, Brr()


  6.     Set D = CreateObject("Scripting.Dictionary")
  7.     Arr = Range(Cells(1, 1), Cells(106, 10))
  8.     Debug.Print Range(Cells(1, 1), Cells(106, 10)).Address(False, False)
  9.     For i = 1 To UBound(Arr)
  10.         For j = 1 To UBound(Arr, 2)
  11.             If Val(Arr(i, j)) > 0 Then
  12.                 r = r + 1
  13.                 ReDim Preserve S(1 To r)
  14.                 S(r) = Arr(i, j)
  15.             End If
  16.         Next
  17.         r = 0
  18.         If r >= 5 Then
  19.             For i1 = 1 To r - 4
  20.                 For i2 = i1 + 1 To r - 3
  21.                     For i3 = i2 + 1 To r - 2
  22.                         For i4 = i3 + 1 To r - 1
  23.                             For i5 = i4 + 1 To r
  24.                                 x = S(i1) & "," & S(i2) & "," & S(i3) & "," & S(i4) & "," & S(i5)
  25.                                 D(x) = ""
  26.                             Next
  27.                         Next
  28.                     Next
  29.                 Next
  30.             Next
  31.         End If

  33.     Next
  34.     k = D.keys
  35.     If D.Count > 0 Then
  36.         ReDim Brr(1 To D.Count, 1 To 10)
  37.         For i = 0 To UBound(k)
  38.             aa = Split(k(i), ",")
  39.             For j = 0 To UBound(aa)
  40.                 If aa(j) <> "" Then Brr(i + 1, aa(j)) = aa(j)
  41.             Next
  42.         Next
  43.         Cells(144, 1).Resize(UBound(Brr), 10) = Brr
  44.         'D.RemoveAll
  45. else
  46.    msgbox "没有有效数据"
  47.     End If
  48. End Sub
复制代码
回复

使用道具 举报

ymq123
 楼主| 发表于 2013-4-17 16:43 | 显示全部楼层
ymq123 发表于 2013-4-17 14:30
没有反应。谢谢！！！！！！！！！！！！！！！！！！！！

老师你好：麻烦你把这道题能执行操作的代码发给我。谢谢！
回复

使用道具 举报

ymq123
 楼主| 发表于 2013-4-17 17:21 | 显示全部楼层
ymq123 发表于 2013-4-17 16:43
老师你好：麻烦你把这道题能执行操作的代码发给我。谢谢！

不好意思又要麻烦你，这个代码虽然能运行，但是不能达到把每行数字组合成5个数字的目的，请你再帮助我修改一下。谢谢！
回复

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-4-27 02:45 , Processed in 0.376968 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表