Одномерный массив из диапазона Excel

Ответ 1

Sub test2()
    Dim arTmp
    Dim securities()
    Dim counter As Long, i As Long
    arTmp = Range("a1").CurrentRegion
    counter = UBound(arTmp, 1)
    ReDim securities(1 To counter)
    For i = 1 To counter
        securities(i) = arTmp(i, 1)
    Next i
    MsgBox "done"
End Sub

Ответ 2

Я знаю, что вы уже приняли ответ, но вот для вас более простой код:

Если вы захватываете одну строку (с несколькими столбцами), используйте:

Securities = application.transpose(application.transpose _
             (Worksheets(3).Range("A8:A" & SymbolCount).Value))

Если вы захватываете один столбец (с несколькими строками), используйте:

Securities = application.transpose(Worksheets(3).Range("A8:A" & SymbolCount).Value)

Итак, в основном вы просто переносите дважды для строк и один раз для столбцов.

Update:

Большие таблицы могут не работать для этого решения (как указано в комментарии ниже):

Я использовал это решение в большой таблице, и я обнаружил, что существует ограничение на этот трюк: Application.Transpose(Range("D6:D65541").Value) "работает без ошибок, но Application.Transpose(Range("D6:D65542").Value)" ошибка времени выполнения 13 Несоответствие типов

Ответ 3

Если вы читаете значения из одного столбца в массив, как у вас есть, тогда я думаю, что вы получите массив, к которому нужно получить доступ, используя синтаксис array(1, n).

В качестве альтернативы вы можете пропустить все ячейки в ваших данных и добавить их в массив:

Sub ReadIntoArray()
    Dim myArray(), myData As Range, cl As Range, cnt As Integer, i As Integer
    Set myData = Worksheets(3).Range("A8:A" & SymbolCount) //Not sure how you get SymbolCount

    ReDim myArray(myData.Count)

    cnt = 0
    For Each cl In myData
        myArray(cnt) = cl
        cnt = cnt + 1
    Next cl

    For i = 0 To UBound(myArray) //Print out the values in the array as check...
        Debug.Print myArray(i)
    Next i
End Sub

Ответ 4

Это будет отражать ответ iDevlop, но я хотел бы дать вам дополнительную информацию о том, что он делает.

Dim tmpArray As Variant
Dim Securities As Variant

'Dump the range into a 2D array
tmpArray = Sheets(3).Range("A8:A" & symbolcount).Value

'Resize the 1D array
ReDim Securities(1 To UBound(tmpArray, 1))

'Convert 2D to 1D
For i = 1 To UBound(Securities, 1)
    Securities(i) = tmpArray(i, 1)
Next

Вероятно, самый быстрый способ получить 1D-массив из диапазона - вывести диапазон в 2D-массив и преобразовать его в 1D-массив. Это делается путем объявления второго варианта и использования ReDim, чтобы изменить размер его до соответствующего размера после того, как вы сбросите диапазон в первый вариант (обратите внимание, что вам не нужно использовать Array(), вы можете сделать это, как я выше, что более понятно).

Вы просто просматриваете 2D-массив, размещая каждый элемент в массиве 1D.

Надеюсь, это поможет.

Ответ 5

Это возможно, вставив Split/Join и Transpose для создания массива String из диапазона. Я еще не тестировал производительность против цикла, но это определенно один проход.

Этот код принимает диапазон (мой образец был шириной в 1 столбец со 100 строками "abcdefg" ), переставляет его, чтобы преобразовать его в одно измерение, JOINs массив String, используя vbTab в качестве разделителя, затем разделяет связанная строка на vbTab.

Sub testStrArr()
Dim arr() As String
arr = Split(Join(Application.Transpose(Range(Cells(1, 1), Cells(100, 1)).Value), vbTab), vbTab)
Debug.Print arr(2)
End Sub

Он ограничен строковыми массивами, так как Join и Split являются строковыми. Числа потребуют манипулирования.

EDIT 20160418 15:09 GMT

Тестирование с использованием двух методов, запись в массив по циклу и использование Split/Join/Transpose 100 рядов, 10k, 100k, 1mil

Private Function testStrArrByLoop(ByVal lRow As Long)
Dim Arr() As String
Dim i As Long

ReDim Arr(0 To lRow)
For i = 2 To lRow
    Arr(i) = Cells(i, 1).Value
Next i
End Function

Private Function testStrArrFromRng(ByVal lRow As Long)
Dim Arr() As String
Arr = Split(Join(Application.Transpose(Range(Cells(1, 1), Cells(lRow, 1)).Value), vbTab), vbTab)
End Function

Private Function TwoDtoOneD(ByVal lRow As Long)
Dim tmpArr() As Variant
Dim Arr() As String
tmpArr = Range(Cells(2, 1), Cells(lRow, 1)).Value
ReDim Arr(LBound(tmpArr) To UBound(tmpArr))
For i = LBound(tmpArr, 1) To UBound(tmpArr, 1)
    Arr(i) = tmpArr(i, 1)
Next
End Function

Ряды       &nbsp петля;   SplitJoinTranspose

100           0.00     0,00

10000       0,03     0,02

100000     0,35     0,11

& 1000000. NBSP; 3.29     0,86

EDIT 20160418 15:49 GMT Добавлена ​​функция и результаты DoubleDtoOneD

Ряды       Петля   SplitJoinTranspose     TwoDtoOneD

100           0.00     0.00                               0.00

10000       0,03     0,02                               0,01

100000     0,34     0,12                               0,11

1000000.   3,46     0,79                               0,81

EDIT 20160420 01:01 GMT

Ниже приведены Sub и функция, которую я использовал для проведения моих тестов.

Sub CallThem()
' This sub initiates each function call, passing it through a code timer.
    Dim iterations(0 To 3) As Long
    Dim i As Integer
    iterations(0) = 100
    iterations(1) = 10000
    iterations(2) = 100000
    iterations(3) = 1000000

    For i = LBound(iterations) To UBound(iterations)
        Range(Cells(2, 1), Cells(iterations(i), 1)).Value = "abcdefg"
        Cells(i + 1, 2).Value = CalculateRunTime_Seconds("testStrArrByLoop", iterations(i))
        Cells(i + 1, 3).Value = CalculateRunTime_Seconds("testStrArrFromRng", iterations(i))
        Cells(i + 1, 4).Value = CalculateRunTime_Seconds("TwoDtoOneD", iterations(i))
        Cells(i + 1, 5).Value = iterations(i)
    Next i
End Sub


Private Function CalculateRunTime_Seconds(fnString As String, iterations As Long) As Double
'PURPOSE: Determine how many seconds it took for code to completely run
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim StartTime As Double
Dim SecondsElapsed As Double

'Remember time when macro starts
  StartTime = Timer

 Result = Application.Run(fnString, iterations)

'Determine how many seconds code took to run
  CalculateRunTime_Seconds = Timer - StartTime

End Function

EDIT 20160420 12:48 GMT

Как отметил @chris neilsen, в моих тестах определенно недостаток. Кажется, что массив для Split/Join/Transpose занимает не более 16 тыс. Строк, который все еще находится под пределом 65 тыс., Которые он указал. Это, я признаю, является для меня неожиданностью. Мои тесты были определенно неполными и ошибочными.