Страницы: 1
RSS
Правильное создание двумерного массива из произвольных столбцов плоской таблицы в VBA
 
Добрый день.
Помогите пож по ситуации.
Есть таблица, скажем, из 100 строк и 10 столбцов. Как правильно (в плане быстродействия и лаконичности кода) одним движением сформировать двумерный массив из, например, 100 строк и 3 выбранных столбцов. Например, массив из 2-го, 4-го, 7-го столбцов.
Искал какой-нибудь красивый и быстрый способ аналогичный: arr(1 to 100, 1) = range(cells(1,2),cells(100,2)) - (сам придумал, понимаю, что ерунда), т.е. столбец за столбцом загонять в массив, но не нашел нигде ничего подобного.
Возможно, кроме перебора ячеек нет другого способа... Жаль, но это тоже устраивает, т.к. не буду тратить время на поиски красивой и быстрой альтернативы перебору ячеек, которой не существует
 
Как вариант
Код
    Dim yx As Variant
    Dim z As Variant
    ReDim z(1 To 3)
    
    yx = Range(Cells(1, 2), Cells(100, 2))
    z(1) = yx
    
    yx = Range(Cells(1, 4), Cells(100, 4))
    z(2) = yx
    
    yx = Range(Cells(1, 7), Cells(100, 7))
    z(3) = yx
 
МатросНаЗебре, спасибо за способ
У меня получилось в итоге 3 массива одномерных, в каждом из которых по столбцу.
Нельзя ли получить один общий массив?
 
Ливиан, вы бы файл-пример сделали - глядишь, дело бы быстрее пошло. Пока так можно, например
Код
Sub t
dim arr, col, arrNew(), r&, c as Byte

Redim arrNew(1 to 100, 1 to 3)
arr=cells(1,1).Resize(100,7).value2

   For Each col in array(2,4,7)
      c=c+1
      For r=1 to ubound(arr,1)
         arrNew(r,c)=arr(r,col)
      Next r
   Next col

End Sub
Изменено: Jack Famous - 18.11.2019 11:51:18
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous, спасибо за помощь
прилагаю пример, с обоими макросами
 
Ливиан, пожалуйста. В примере должно быть видно "как есть" и "как надо", а у вас не так. Если мой вариант подошёл, то пример можно не делать (или делать как положено), а если не совсем подошёл, то расскажите/покажите что не так
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Ваш вариант работает и дает в результате то, то должно быть получено, т.е. один массив с 3 выбранными столбцами. Есть правда перебор элементов массивов, я надеялся избежать его, но так понимаю это неизбежно, так что этот пункт не был достигнут, но это уже претензии к VBA. Остальные пункты (быстродействие и лаконичность) тоже были достигнуты, по сравнению как я бы это сделал, мой код был бы намного больше  и я бы не догадался сначала всю таблицу в массив а затем в новый массив нужные столбцы вытянуть из массива - это думаю быстрее чем перебирать ячейки.
Пример дополнил желаемым результатом.
Всем спасибо, задача разрешена 2 способами. Способ 1 тоже очень даже рабочий (просто я заклинился на то, что получиться должен 1 массив) и хоть и получается 3 массива, а не один - но это не сильно принципиально, как  я только сейчас начинаю понимать, т.к. работать с ними можно как с одним - очень интересный прием, объявляется один массив ReDim z(1 To 3), а в результате получается 3 массива с порядковыми номерами z(1), z(2), z(3)...
Еще раз всем спасибо, очень помогли!
Изменено: Ливиан - 18.11.2019 12:53:27
 
Может это что то подобное ?
Код
Option Explicit

Sub abc_xyz()
    Dim rws&, tbl()
    Range("M1").CurrentRegion.ClearContents
    rws = Cells(Rows.Count, "A").End(xlUp).Row
    tbl = Application.Index(Range("A1:K11"), Application.Evaluate("Row(1:" & rws & ")"), Array(2, 4, 7))
    Range("M1").Resize(UBound(tbl), 3) = tbl
End Sub
 
Цитата
Ливиан: Есть правда перебор элементов массивов, я надеялся избежать его, но так понимаю это неизбежно, так что этот пункт не был достигнут, но это уже претензии к VBA
есть варианты, как избежать прямого перебора (например вариант в "#8"), НО
    • если перебора нет в коде VBA, это не значит, что его нет в принципе (вшит внутрь функции)
    • краткость кода обеспечена, скорость можете замерить - так зачем бежать от цикла?…
    • метод получения массива через Evaluate ограничен областью применения (разбор). Прямой цикл быстрее и универсальнее
Изменено: Jack Famous - 18.11.2019 13:13:43
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
ocet p, Ваш вариант тоже рабочий. Спасибо большое. Все 3 варианта работают, как говорится, выбирай любой
 
Цитата
Jack Famous написал:
краткость кода обеспечена, скорость можете замерить - так зачем бежать от цикла?…
У меня просто постоянные метания между скоростью и количеством строк кода... Дело в том, что я панически боюсь длинные макросы, когда открываю их - сразу желание закрыть макрос... поэтому всегда стремлюсь к максимальной лаконичности и выразительности. Циклов, особенно вложенных, тоже стараюсь по возможности избежать (так как мозг сразу готовится к чему-то сложному) - вот и ищу постоянно альтернативы. Если бы скорость выполнения макросов не была бы критична, я бы всегда выбирал самый простой и легко читаемый код... Но в данном случае, Ваш код меня полностью устраивает, я его в принципе понимаю, он  очень быстрый (так как работает с начала и до конца с массивами) и довольно короткий. И это конечно говорит о высоком профессионализме.
Спасибо еще раз всем большое, задача полностью решена 3 способами. Правда появился один минус - нужно выбрать из 3 отличных вариантов один :)
 
Код
'******************************************************************************
' получение сплошного массива из несмежных колонок диапазона активного листа
' rs - начальная и конечная строки диапазона (в массиве)
' cs - №№ колонок, которые должны быть включены в результат (в массиве)
Function ArrayFromRangeCLMNS(rs, cs) '
  Dim i&, s$, d&, RefSt
  For i = LBound(cs) To UBound(cs)
    s = Columns(cs(i)).Address(0, 0): d = InStr(s, ":")
    s = Left(s, d - 1) & rs(LBound(rs)) & ":" & Left(s, d - 1) & rs(UBound(rs))
    rgs = rgs & "," & s: cs(i) = i + 1 - LBound(cs)
  Next
  RefSt = Application.ReferenceStyle: Application.ReferenceStyle = xlA1
  ArrayFromRangeCLMNS = Evaluate("CHOOSE({" & Join(cs, ",") & "}" & rgs & ")")
  Application.ReferenceStyle = RefSt
End Function

' пример использования
Sub Test()
  Dim a
  a = ArrayFromRangeCLMNS(Array(2, 100), Array(2, 7, 4))
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, спасибо большое, все работает
Цитата
Ливиан написал:
Спасибо еще раз всем большое, задача полностью решена 3 способами. Правда появился один минус - нужно выбрать из 3 отличных вариантов один
теперь из 4 :)
 
Цитата
Ливиан: Циклов, особенно вложенных, тоже стараюсь по возможности избежать
так вы далеко не уйдёте, т.к. циклы можно назвать определяющим элементом автоматизации — придумали алгоритм и пустили выполнение его в цикле (мануал по циклам)
Цитата
Ливиан: постоянные метания между скоростью и количеством строк кода … панически боюсь длинные макросы … стремлюсь к максимальной лаконичности и выразительности
для того, чтобы сделать что-то сложное простым и доступным (для понимания и обслуживания), нужно разбивать процессы на исполнительные функции (или процедуры, но функцией проще отследить, если что-то пошло не так) и комментировать свой код. Ігор Гончаренко, по сути, так и сделал, а я добавляю свой вариант  ;)
Основная функция и пример вызова
Изменено: Jack Famous - 18.11.2019 14:47:06
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous, спасибо огромное как за красивый, быстрый код (у меня на ноуте отработал за 31 мс), так и за ценные советы.
Еще раз, всем откликнувшимся, большое спасибо
 
Ливиан, обращайтесь  ;)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Страницы: 1
Наверх