[已解决]关于数组问题

dtxczjzmp

不知错在哪？arrr数组怎么是空值呢？ 10月.rar (14.83 KB, 下载次数: 22)

2011-11-16 18:21 上传

点击文件名下载附件
Sub qs()
Dim arr, arrr(), i As Integer, y As Integer
    With Sheets("10")
        r1 = .Range("b65536").End(xlUp).Row
        arr = .Range("a2:h" & r1)
    End With

    With Sheets("sheet1")
        For i = 1 To UBound(arr)
            If Len(arr(i, 1)) > 5 And arr(i, 6) > 0 Then
                For y = 1 To 200
                    ReDim arrr(1 To 200, 1 To 6)
                    arrr(y, 1) = arr(i, 2)
                    arrr(y, 2) = arr(i, 1)
                    arrr(y, 4) = arr(i, 6)
                    arrr(y, 6) = arr(i, 2)
                Next
            End If
       Next

    End With
    Sheets("sheet1").[a2:f200] = arrr
'Stop
End Sub

最佳答案

月排行榜 / 总排行榜

lisachen

2011-11-16 18:45

试试这个

1. 
   
2. Sub qs()
   
3.     Dim arr, arrr(), i As Integer, y As Integer
   
4.     With Sheets("10")
   
5.         r1 = .Range("b65536").End(xlUp).Row
   
6.         arr = .Range("a2:h" & r1)
   
7.     End With
   
8.     ReDim arrr(1 To 200, 1 To 6)
   
9.     With Sheets("sheet1")
   
10.         For i = 1 To UBound(arr)
    
11.             If Len(arr(i, 1)) > 5 And arr(i, 6) > 0 Then
    
12.                 y = y + 1
    
13.                 arrr(y, 1) = arr(i, 2)
    
14.                 arrr(y, 2) = arr(i, 1)
    
15.                 arrr(y, 4) = arr(i, 6)
    
16.                 arrr(y, 6) = arr(i, 2)
    
17.             End If
    
18.         Next
    
19.     End With
    
20.     Sheets("sheet1").[a2:f201] = ""
    
21.     Sheets("sheet1").[a2:f201] = arrr
    
22. End Sub

复制代码

跳转到最佳答案楼层

lisachen

试试这个

1. 
   
2. Sub qs()
   
3.     Dim arr, arrr(), i As Integer, y As Integer
   
4.     With Sheets("10")
   
5.         r1 = .Range("b65536").End(xlUp).Row
   
6.         arr = .Range("a2:h" & r1)
   
7.     End With
   
8.     ReDim arrr(1 To 200, 1 To 6)
   
9.     With Sheets("sheet1")
   
10.         For i = 1 To UBound(arr)
    
11.             If Len(arr(i, 1)) > 5 And arr(i, 6) > 0 Then
    
12.                 y = y + 1
    
13.                 arrr(y, 1) = arr(i, 2)
    
14.                 arrr(y, 2) = arr(i, 1)
    
15.                 arrr(y, 4) = arr(i, 6)
    
16.                 arrr(y, 6) = arr(i, 2)
    
17.             End If
    
18.         Next
    
19.     End With
    
20.     Sheets("sheet1").[a2:f201] = ""
    
21.     Sheets("sheet1").[a2:f201] = arrr
    
22. End Sub

复制代码

variable

下标越界，怎么回事

那么的帅

用了2种不同的方法

1. 
   
2. Sub qs1()  '利用动态数组
   
3.     Dim arr, arrr(), i As Integer, y As Integer
   
4.     With Sheets("10")
   
5.         r1 = .Range("b65536").End(xlUp).Row
   
6.         arr = .Range("a2:h" & r1)
   
7.     End With
   
8.     With Sheets("sheet1")
   
9.         For i = 1 To UBound(arr)
   
10.             If Len(arr(i, 1)) > 5 And arr(i, 6) > 0 Then
    
11.                 K = K + 1
    
12.                 ReDim Preserve arrr(1 To 6, 1 To K)
    
13.                 arrr(1, K) = arr(i, 2)
    
14.                 arrr(2, K) = arr(i, 1)
    
15.                 arrr(4, K) = arr(i, 6)
    
16.                 arrr(6, K) = arr(i, 2)
    
17.             End If
    
18.         Next
    
19.         .Range("A2:F65536").ClearContents
    
20.         .[a2].Resize(K, 6) = Application.Transpose(arrr)
    
21.     End With
    
22. End Sub
    
23. Sub qs2() '利用固定数组
    
24.     Dim arr, arrr(), i As Integer, y As Integer
    
25.     With Sheets("10")
    
26.         r1 = .Range("b65536").End(xlUp).Row
    
27.         arr = .Range("a2:h" & r1)
    
28.     End With
    
29.     ReDim arrr(1 To 200, 1 To 6)
    
30.     With Sheets("sheet1")
    
31.         For i = 1 To UBound(arr)
    
32.             If Len(arr(i, 1)) > 5 And arr(i, 6) > 0 Then
    
33.                 y = y + 1
    
34.                 arrr(y, 1) = arr(i, 2)
    
35.                 arrr(y, 2) = arr(i, 1)
    
36.                 arrr(y, 4) = arr(i, 6)
    
37.                 arrr(y, 6) = arr(i, 2)
    
38.             End If
    
39.         Next
    
40.         .Range("A2:F65536").ClearContents
    
41.         .[a2:f201] = arrr
    
42.     End With
    
43. End Sub
    

复制代码

dtxczjzmp

谢谢lisachen版主的关心和帮助！

dtxczjzmp

谢谢 那么的帅 的关心和帮助！

dtxczjzmp

还有个问题：当“item”字段中代码中前面5位是"10301"，则在这个字段代码前“405”，如1030118，取数后在shee1工作表b列中对应的行中的值“4051030118”，其余的则前面全部加“401”；然后取数后在shee1工作表d列最后一行加个合计数。