[已解决]数据移动的问题

Baibdu

附件 数据移动附件.zip (4.5 KB, 下载次数: 1)

2015-1-6 14:36 上传

点击文件名下载附件
谢谢！

最佳答案

月排行榜 / 总排行榜

爱疯

2015-1-6 14:47

Sub Click()
    Dim A, B, i, j, s
    A = Range("a1").CurrentRegion
    ReDim B(1 To UBound(A, 2) * 2, 1 To 1)
    For j = 1 To UBound(A, 2)
        For i = 1 To 2
            s = s + 1
            B(s, 1) = A(i, j)
        Next i
    Next j
    [a2:a65536] = ""
    [a1].Resize(UBound(B)) = B
End Sub
数据移动附件2.rar (12.37 KB, 下载次数: 3)

2015-1-6 14:47 上传

点击文件名下载附件

跳转到最佳答案楼层

爱疯

Sub Click()
    Dim A, B, i, j, s
    A = Range("a1").CurrentRegion
    ReDim B(1 To UBound(A, 2) * 2, 1 To 1)
    For j = 1 To UBound(A, 2)
        For i = 1 To 2
            s = s + 1
            B(s, 1) = A(i, j)
        Next i
    Next j
    [a2:a65536] = ""
    [a1].Resize(UBound(B)) = B
End Sub
数据移动附件2.rar (12.37 KB, 下载次数: 3)

2015-1-6 14:47 上传

点击文件名下载附件