Question

我要形成一个一维的作业代码数组，我需要将该数组移到工作簿中的另一个工作表中。我想将列表转置为单元格（从c2到-最后一列/第2行）。我知道这需要`application.transpose（varArray）之类的东西，但是我不知道如何在代码的打印数组部分达到这一点。

Sub JC_Fill()

    Dim varArray() As Variant, rng As Range
    Dim x As Long, i As Long

    i = 0
    x = 2

    With ThisWorkbook.Worksheets("Sheet1").UsedRange.Rows.Count

        ReDim varArray(0)                        'resize array

        Do Until Cells(x, 2).Value = ""

            If Cells(x, 2).Value = "JC" Then
                varArray(i) = Cells(x, 1).Value
                i = i + 1
                ReDim Preserve varArray(i)
            End If

            x = x + 1
        Loop

        ReDim Preserve varArray(i - 1)

    End With

    With ThisWorkbook.Worksheets("Profiles")

        Set rng = Range("C2")                    'cell I want to move array to, but transposed

        For i = 0 To UBound(varArray)
            'go through 1d array and transpose paste them (c2, d2, e2, f2, etc...)
        Next i

    End With

End Sub

如何告诉VBA将1d数组转置到sheets（“ profiles”）的range（“ C2”）中？

Answer 1

首先在1而不是0处启动varArray。请执行以下操作，而不是ReDim varArray(0)：

ReDim varArray(1 to 1)

和

i = 1

代替i=0

然后只分配数组，不循环：

ThisWorkbook.Worksheets("Profiles").Range("C2").Resize(1,UBound(varArray)).Value = varArray

构建数组的方法是水平的而不是垂直的，因此不需要转置。

但是要加快速度，请循环数组而不是范围：

Sub JC_Fill()



    With ThisWorkbook.Worksheets("Sheet1")

        Dim varArray() As Variant
        ReDim varArray(1 To Application.CountIf(.Range("B:B", "JC"))) 'resize array

        Dim lstRow As Long
        lstRow = .Cells(.Rows.Count, 2).End(xlUp).Row

        Dim rng As Variant
        rng = .Range(.Cells(1, 1), .Cells(lstRow, 2))

        Dim x As Long
        x = 1

        Dim i As Long
        For i = LBound(rng, 1) To UBound(rng, 1)
            If rng(i, 2) = "JC" Then
                varArray(x) = rng(i, 1)
                x = x + 1
            End If
        Next i
    End With

    ThisWorkbook.Worksheets("Profiles").Range("C2").Resize(1, UBound(varArray)).Value = varArray

End Sub

如何将此一维数组转置到另一个工作表？

1 个答案: