[已解决]请老师解决下标越界的问题

win9

请老师解决下标越界的问题

11111111.rar (12.15 KB, 下载次数: 29)

2011-11-2 21:44 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

mxg825

2011-11-2 22:40

Sub AA333()
Dim X%, Y%, Z%, M%, K%, G&, D
Set D = CreateObject("Scripting.Dictionary")
With Sheets("发发发")
   Y = .Range("E65536").End(3).Row
   ReDim ARR1(1 To Y - 2, 1 To 4)
   arr = .Range("E3:E" & Y + 1)
      For Z = 2 To Sheets.Count
          D.Add Sheets(Z).Range("B2").Value, Z
      Next Z
   For K = 1 To UBound(arr) - 1      
G = D.Item(arr(K, 1))
       For M = 1 To 4
        Set C = Sheets(G).Range("A1:I65536").Find(.Cells(2, 5 + M), SearchFormat:=True)
          If C Is Nothing Then
             ARR1(K, M) = ""
          Else
             ARR1(K, M) = C.Offset(, 1).Value
         End If
       Next M
   Next K
.Range("F3:I" & Y) = ARR1
End With
End Sub

跳转到最佳答案楼层

studyexcel

回复 win9 的帖子

Option Explicit
你在最顶端加上这个，把需要的变量先定义好

上清宫主

arr = .Range("E3:E" & Y)
而表中只有三行，y=3，所以arr得到一个值，arr就不是数组了，故ubound(arr)要出错。

win9

回复 studyexcel 的帖子

请老师帮忙改好行吗？


本人小菜，请老师帮忙谢谢！

上清宫主

Sub AA333()
Dim X%, Y%, Z%, M%, K%, G&, D
Set D = CreateObject("Scripting.Dictionary")
With Sheets("发发发")
   Y = .Range("E65536").End(3).Row
   ReDim ARR1(1 To Y - 2, 1 To 4)
   arr = .Range("E3:E" & Y)
      For Z = 2 To Sheets.Count
          D.Add Sheets(Z).Range("B2").Value, Z
      Next Z
   For K = 1 To Y - 2
       If Y = 3 Then
          G = D.Item(arr)
       Else
          G = D.Item(arr(K, 1))
       End If
       For M = 1 To 4
        Set C = Sheets(G).Range("A1:I65536").Find(.Cells(2, 5 + M), SearchFormat:=True)
          If C Is Nothing Then
             ARR1(K, M) = ""
          Else
             ARR1(K, M) = C.Offset(, 1).Value
         End If
       Next M
   Next K
.Range("F3:I" & Y) = ARR1
End With
End Sub

改得有点哈

mxg825

Sub AA333()
Dim X%, Y%, Z%, M%, K%, G&, D
Set D = CreateObject("Scripting.Dictionary")
With Sheets("发发发")
   Y = .Range("E65536").End(3).Row
   ReDim ARR1(1 To Y - 2, 1 To 4)
   arr = .Range("E3:E" & Y + 1)
      For Z = 2 To Sheets.Count
          D.Add Sheets(Z).Range("B2").Value, Z
      Next Z
   For K = 1 To UBound(arr) - 1      
G = D.Item(arr(K, 1))
       For M = 1 To 4
        Set C = Sheets(G).Range("A1:I65536").Find(.Cells(2, 5 + M), SearchFormat:=True)
          If C Is Nothing Then
             ARR1(K, M) = ""
          Else
             ARR1(K, M) = C.Offset(, 1).Value
         End If
       Next M
   Next K
.Range("F3:I" & Y) = ARR1
End With
End Sub

上清宫主

就是说有点哈嘛。
还是6楼好{:011:}