求助

840205910

我开始做的，提示下界越标
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Not Intersect(Target, [a2:h3000]) Is Nothing Then Call l
    Application.EnableEvents = True
End Sub
Sub l()
    Dim arr As Variant
    Dim i As Integer, j As Integer
    arr = Sheet1.[a2:h3000].Value
    ReDim brr(1 To 12000, 1 To 2)
    Set d = CreateObject("scripting.dictionary")
    For j = 1 To 8 Step 2
        For i = 2 To 3000
          S = arr(i, j)
          If Not d.exists(S) Then
                n = n + 1
               d(S) = n
                brr(n, 1) = arr(i, j)
                brr(n, 2) = Val(arr(i, j + 1))
                Else
                brr(d(S), 2) = brr(d(S), 2) + Val(arr(i, j + 1))
            End If
        Next
    Next
   
   
    Sheet1.[k2].Resize(UBound(brr), 2) = brr
End Sub

840205910

zhaogang1960 发表于 2012-7-23 15:51
数据较多时应避免使用Transpose函数转置
Sub Macro2()
    Dim arr, brr(), d As Object, i&, j%, m&

赵老师，你好。我做的为什么会下界越标？

zhaogang1960

840205910 发表于 2012-7-23 16:17
赵老师，你好。我做的为什么会下界越标？

你使用了“绝对”坐标 For i = 2 To 3000， 数组也应该从第一行开始arr = Sheet1.[a1:h3000].Value

1. Sub l()
   
2.      Dim arr As Variant
   
3.      Dim i As Integer, j As Integer
   
4. '     arr = Sheet1.[a2:h3000].Value
   
5.      arr = Sheet1.[a1:h3000].Value
   
6.      ReDim brr(1 To 12000, 1 To 2)
   
7.      Set d = CreateObject("scripting.dictionary")
   
8.      For j = 1 To 8 Step 2
   
9.          For i = 2 To 3000
   
10.            s = arr(i, j)
    
11.            If Not d.exists(s) Then
    
12.                  n = n + 1
    
13.                 d(s) = n
    
14.                  brr(n, 1) = arr(i, j)
    
15.                  brr(n, 2) = Val(arr(i, j + 1))
    
16.                  Else
    
17.                  brr(d(s), 2) = brr(d(s), 2) + Val(arr(i, j + 1))
    
18.              End If
    
19.          Next
    
20.      Next
    
21.    
    
22.      
    
23.     Sheet1.[k2].Resize(UBound(brr), 2) = brr
    
24. End Sub
    

复制代码

如果使用arr = Sheet1.[a2:h3000]，则For i=1 to 2999

840205910

谢谢赵老师