VBA数组反向粘贴

huangrh1

A-D列是原始效果

要求得到效果为G-J列

要求用VBA数组实现
见附件

百度不到去谷歌

你反向循环不就好了 你这数据仅仅是列反向就更容易了

1. Public Sub 列反向复制(rng As Range, r As Range)
   
2.     Dim i&, n&
   
3.     n = rng.Columns.Count
   
4.     Set r = r.Resize(rng.Rows.Count)
   
5.     For i = n To 1 Step -1
   
6.         r.Offset(0, n - i) = rng.Columns(i).Value
   
7.     Next
   
8.    
   
9. End Sub
   
10. 
    
11. Public Sub test()
    
12.      [L:O].Clear
    
13.     列反向复制 [A1:D21], [L1]
    
14. End Sub

复制代码

bluexuemei

请安装ActiveRuby然后运行以下代码，下载地址 http://www.artonx.org/data/asr/ActiveRuby.msi

1. Sub t()
   
2. Set ojs = CreateObject("scriptcontrol"): ojs.Language = "rubyscript"
   
3. ojs.eval ("def aa(aa) $aa=aa end")
   
4. arr = Range("a1", [d1].End(4))
   
5. y = ojs.Run("aa", arr)
   
6. y = ojs.eval("$aa.map(&:reverse)")
   
7. [g1].Resize(UBound(y) + 1, UBound(y, 2) + 1) = y
   
8. Set ojs = Nothing
   
9. 'Stop
   
10. End Sub
    

复制代码

zax010

来个简单的：
Sub zz()
    lr = Range("A65536").End(xlUp).Row
    For i = 1 To lr
        n = 3
        For j = 4 To 1 Step -1
            Cells(i, n + 4) = Cells(i, j)
            n = n + 1
        Next
    Next
End Sub

zax010

。。。“要求用VBA数组实现”。。。

Sub zz()
    Dim arr, brr
    arr = Sheet1.Range("A1").CurrentRegion
    ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
    For i = 1 To UBound(arr)
        m = 1
        For j = UBound(arr, 2) To 1 Step -1
            brr(i, m) = arr(i, j)
            m = m + 1
        Next
    Next
    [g1].Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub