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

Excel精英培训网

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

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

[复制链接]
ymq123
发表于 2013-4-4 21:48 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
请高手帮助查找代码 result(l, m) = arr1(i, m)下标越界原因。谢谢
最佳答案
月排行榜 / 总排行榜
hwc2ycy
2013-4-4 22:10
  1. Private Sub 相同_Click()


  4.     Dim arr1, arr2
  5.     Dim key1 As String
  6.     Dim result()
  7.     Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer
  8.     Dim blCancel As Boolean

  10.     arr1 = Range("a1:j252")
  11.     arr2 = Range("a254:j505")
  12.     ReDim result(1 To UBound(arr1), 1 To UBound(arr1, 2))
  13.     For i = LBound(arr1) To UBound(arr1)
  14.         For j = LBound(arr1) To UBound(arr1)
  15.             blCancel = False
  16.             key1 = ""
  17.             For k = LBound(arr1, 2) To UBound(arr1, 2)
  18.                 key1 = key1 & arr1(i, k)
  19.                 If arr1(i, k) <> arr2(j, k) Then
  20.                     blCancel = True
  21.                     Exit For
  22.                 End If
  23.             Next
  24.             If Not blCancel And Len(key1) > 0 Then
  25.                 Debug.Print "arr1(" & i & "--arr2)" & j
  26.                 l = l + 1
  27.                 For m = LBound(arr1, 2) To UBound(arr1, 2)
  28.                     result(l, m) = arr1(i, m)
  29.                 Next
  30.             End If
  31.         Next
  32.     Next
  33.     If l > 0 Then
  34.         Range("a4049").Resize(l, UBound(arr1, 2)) = result
  35.     Else
  36.         MsgBox "无相同的数据行"
  37.     End If

  39.     arr1 = Range("a507:j758")
  40.     arr2 = Range("a760:j1011")
  41.     ReDim result(1 To UBound(arr1), 1 To UBound(arr1, 2))
  42.     l = 0
  43.     For i = LBound(arr1) To UBound(arr1)
  44.         For j = LBound(arr1) To UBound(arr1)
  45.             blCancel = False
  46.             key1 = ""
  47.             For k = LBound(arr1, 2) To UBound(arr1, 2)
  48.                 key1 = key1 & arr1(i, k)
  49.                 If arr1(i, k) <> arr2(j, k) Then
  50.                     blCancel = True
  51.                     Exit For
  52.                 End If
  53.             Next
  54.             If Not blCancel And Len(key1) > 0 Then
  55.                 Debug.Print "arr1(" & i & "--arr2)" & j
  56.                 l = l + 1
  57.                 For m = LBound(arr1, 2) To UBound(arr1, 2)
  58.                     result(l, m) = arr1(i, m)
  59.                 Next
  60.             End If
  61.         Next
  62.     Next
  63.     If l > 0 Then
  64.         Range("a1012").Resize(l, UBound(arr1, 2)) = result
  65.     Else
  66.         MsgBox "无相同的数据行"
  67.     End If


  70. End Sub
复制代码

请都是帮助查找下标越界原因.rar

47.66 KB, 下载次数: 5
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
hwc2ycy
发表于 2013-4-4 22:09 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
代码第二部分取数据时，先把L置为0呢。
回复

使用道具 举报

hwc2ycy
发表于 2013-4-4 22:10 | 显示全部楼层    本楼为最佳答案   
工作中最常用的Excel函数公式，全印在一张鼠标垫上
  1. Private Sub 相同_Click()


  4.     Dim arr1, arr2
  5.     Dim key1 As String
  6.     Dim result()
  7.     Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer
  8.     Dim blCancel As Boolean

  10.     arr1 = Range("a1:j252")
  11.     arr2 = Range("a254:j505")
  12.     ReDim result(1 To UBound(arr1), 1 To UBound(arr1, 2))
  13.     For i = LBound(arr1) To UBound(arr1)
  14.         For j = LBound(arr1) To UBound(arr1)
  15.             blCancel = False
  16.             key1 = ""
  17.             For k = LBound(arr1, 2) To UBound(arr1, 2)
  18.                 key1 = key1 & arr1(i, k)
  19.                 If arr1(i, k) <> arr2(j, k) Then
  20.                     blCancel = True
  21.                     Exit For
  22.                 End If
  23.             Next
  24.             If Not blCancel And Len(key1) > 0 Then
  25.                 Debug.Print "arr1(" & i & "--arr2)" & j
  26.                 l = l + 1
  27.                 For m = LBound(arr1, 2) To UBound(arr1, 2)
  28.                     result(l, m) = arr1(i, m)
  29.                 Next
  30.             End If
  31.         Next
  32.     Next
  33.     If l > 0 Then
  34.         Range("a4049").Resize(l, UBound(arr1, 2)) = result
  35.     Else
  36.         MsgBox "无相同的数据行"
  37.     End If

  39.     arr1 = Range("a507:j758")
  40.     arr2 = Range("a760:j1011")
  41.     ReDim result(1 To UBound(arr1), 1 To UBound(arr1, 2))
  42.     l = 0
  43.     For i = LBound(arr1) To UBound(arr1)
  44.         For j = LBound(arr1) To UBound(arr1)
  45.             blCancel = False
  46.             key1 = ""
  47.             For k = LBound(arr1, 2) To UBound(arr1, 2)
  48.                 key1 = key1 & arr1(i, k)
  49.                 If arr1(i, k) <> arr2(j, k) Then
  50.                     blCancel = True
  51.                     Exit For
  52.                 End If
  53.             Next
  54.             If Not blCancel And Len(key1) > 0 Then
  55.                 Debug.Print "arr1(" & i & "--arr2)" & j
  56.                 l = l + 1
  57.                 For m = LBound(arr1, 2) To UBound(arr1, 2)
  58.                     result(l, m) = arr1(i, m)
  59.                 Next
  60.             End If
  61.         Next
  62.     Next
  63.     If l > 0 Then
  64.         Range("a1012").Resize(l, UBound(arr1, 2)) = result
  65.     Else
  66.         MsgBox "无相同的数据行"
  67.     End If


  70. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
ymq123 + 3

查看全部评分

回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-4-20 19:40 , Processed in 0.366491 second(s), 15 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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