Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 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 Ноя 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 Ноя 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 Ноя 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 Ноя 2019 14:47:06
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Jack Famous, спасибо огромное как за красивый, быстрый код (у меня на ноуте отработал за 31 мс), так и за ценные советы.
Еще раз, всем откликнувшимся, большое спасибо
 
Ливиан, обращайтесь  ;)
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
Страницы: 1
Читают тему (гостей: 1)
Наверх