[已解决]数组赋值

lingyuncelia

运行如下代码，得出以上结果
Sub celia()
Dim arr As Variant
arr = Range("a1:a9").Value
Range("b1:d3") = arr
End Sub

如果我想结果如下，该如何改善代码？

最佳答案

月排行榜 / 总排行榜

惘

2017-4-9 12:02

Sub celia()
Dim arr(), arrRC
Dim ROWk As Integer, COLUMNk As Integer, arrK As Integer, arrA As Integer
   
    arrA = ActiveSheet.Range("a65535").End(xlUp).Row
    arrK = Application.RoundUp(Sqr(arrA), 0)
   
    arr = Range("a1:a" & arrA)
    arrRC = 1
   
    For ROWk = 1 To arrK
        For COLUMNk = 1 To arrK
            If arrRC > arrA Then
                COLUMNk = COLUMNk + 1
                Exit For
            Else
                Cells(ROWk, COLUMNk + 1) = arr(arrRC, 1)
                arrRC = arrRC + 1
            End If
        Next COLUMNk
    Next ROWk
   
End Sub

跳转到最佳答案楼层

惘

Sub celia()
Dim arr(), arrRC
Dim ROWk As Integer, COLUMNk As Integer, arrK As Integer, arrA As Integer
   
    arrA = ActiveSheet.Range("a65535").End(xlUp).Row
    arrK = Application.RoundUp(Sqr(arrA), 0)
   
    arr = Range("a1:a" & arrA)
    arrRC = 1
   
    For ROWk = 1 To arrK
        For COLUMNk = 1 To arrK
            If arrRC > arrA Then
                COLUMNk = COLUMNk + 1
                Exit For
            Else
                Cells(ROWk, COLUMNk + 1) = arr(arrRC, 1)
                arrRC = arrRC + 1
            End If
        Next COLUMNk
    Next ROWk
   
End Sub

lingyuncelia

Sub 按行按列赋值()
r = 1
For i = 1 To 3
For j = 2 To 4
Cells(i, j) = Cells(r, 1)
r = r + 1
Next
Next
End Sub