Как мне перенести этот 1d массив на другой лист?

Question

У меня есть одномерный массив кодов заданий, которые я формирую, и мне нужно переместить этот массив в другой лист в книге.Я хочу перенести список в ячейки (c2-to - последний столбец / строка 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 в диапазоне ("C2") листов ("профилей")?

Answer 1

Сначала начните свой varArray с 1, а не с 0. Вместо 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