[已解决]VBA数组把A列拆分保存D列 改写加一个数组输出结果

laoau138

VBA数组把A列拆分保存D列   改写加一个数组输出结果


Sub 按钮2_Click()
    Application.ScreenUpdating = False
    arr = [a1].CurrentRegion
    a = 1
    For j = 1 To UBound(arr) - 4
        For i = j To j + 4
            Cells(a, 4) = arr(i, 1)
            a = a + 1
        Next i
        a = a + 1
    Next j
    Application.ScreenUpdating = True
End Sub


'VBA数组把A列拆分保存D列 改写加一个数组输出结果

'把A列数字每5个拆分一组保存D列 中间用一个空格隔开

'A列单元格存入数组arr

'把下面两句改写加一个数组brr输出结果到D列

   'Cells(a, 4) = arr(i, 1)

          '  a = a + 1

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-6-8 10:48

1. Sub aaa()
   
2. Dim arr, brr, n&
   
3. arr = [a1].CurrentRegion
   
4. ReDim brr(1 To UBound(arr) * 6 - 25 ,1 To 1)
   
5. For i = 1 To UBound(arr) - 4
   
6.   For j = i To i + 4
   
7.     n = n + 1
   
8.     brr(n, 1) = arr(j, 1)
   
9.   Next j
   
10.   n = n + 1
    
11. Next i
    
12. [d1].Resize(n - 1) = brr
    
13. End Sub

复制代码

跳转到最佳答案楼层

idnoidno

1. Dim ts As Long
   
2. Dim arr
   
3. Dim brr()
   
4. Set rg = Range("a1:a" & Cells(Rows.Count, 1).End(xlUp).Row)
   
5. arr = rg
   
6. ts = (UBound(arr) - 5 + 1) * 6 - 1
   
7.     a = 1
   
8.     ReDim brr(1 To ts, 1 To 1)
   
9.     For j = 1 To UBound(arr) - 4
   
10.         For i = j To j + 4
    
11.             brr(a, 1) = arr(i, 1)
    
12.             a = a + 1
    
13.         Next i
    
14.         a = a + 1
    
15.     Next j
    
16. [f1].Resize(ts, 1) = brr
    
17. End Sub

复制代码

大灰狼1976

1. Sub aaa()
   
2. Dim arr, brr, n&
   
3. arr = [a1].CurrentRegion
   
4. ReDim brr(1 To UBound(arr) * 6 - 25 ,1 To 1)
   
5. For i = 1 To UBound(arr) - 4
   
6.   For j = i To i + 4
   
7.     n = n + 1
   
8.     brr(n, 1) = arr(j, 1)
   
9.   Next j
   
10.   n = n + 1
    
11. Next i
    
12. [d1].Resize(n - 1) = brr
    
13. End Sub

复制代码

laoau138

大灰狼1976 发表于 2017-6-8 10:48

VBA数组行与行比较   不用index方法如何改写

http://www.excelpx.com/thread-430950-1-1.html

laoau138

大灰狼1976 发表于 2017-6-8 10:48

果然是高手