Страницы: 1
RSS
Преобразовать массив (таблицу или несколько столбцов) в столбец
 
Всем привет.
Казалось бы ну нереально банальная задача, и куча разных людей предлагают свои решения, но ни одно из них собственно задачу не выполняют полно и точно.
Задача:
1) Выделяется прямоугольный массив ячеек включающий в себя несколько столбцов
2) Необходимо скопировать в следующий за выделенным столбец все ячейки этого массива в один единый столбец по порядку

Функцией ли - макросом ли, но решение такой простой задача никак не могу найти.
Видел решение через ИНДЕКС в формуле - работает криво.
Видел решение в надстройке какого-то спеца по контекстной рекламе - тоже специфически работает и не всегда.

А вот самой простой и элегантной банальщины не нашел.
В приложении файл описывающий исходные данные в первых трех столбцах и результат их обработки в 4.
 
вот исходный диапазон (2х2)
1 2
3 4
результат 1
1
2
3
4
результат 2
1
3
2
4
Пусть бросит в меня камень, тот кто скажет, что результаты не из исходного диапазона и не по-порядку!
но они-то РАЗНЫЕ

предлагаю начать с банальщины: с формулировки задачи.
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, пример гайдлайнит в этом вопросе, но согласен - это можно было указать дополнительно.
Порядок последовательный сначала 1 столбец сверху вниз - затем 2 столбец сверху вниз и так далее.

P.S. Сейчас еще додумался до дополнительного уточнения - пустые ячейки не копируются.
Изменено: shlackbaum - 09.10.2018 20:28:34
 
может это
Код
Sub JoinToColumn()
  Dim c&, rg As Range
  c = [b1].CurrentRegion.Columns.Count + 1
  For Each rg In [b1].CurrentRegion.Columns
    Cells((rg.Column - 1) * rg.Rows.Count + 1, c).Resize(rg.Rows.Count, 1).Value = rg.Value
  Next
  Columns(c).SpecialCells(xlCellTypeBlanks).Delete
End Sub
поможет?
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, работает, но теряет форматирование и не дает возможности выделения. Задачу по бОльшей части решает, хоть и не обладает полнотой и гибкостью.
 
когда в описании задачи нет описания нюансов - я решаю задачу так как ее понял
(у меня папрочь отсутсвуют способности к чтению мыслей, зато замечательно развились способности к чтению букв, формулируйте мысли буквами - они материализуются)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, спасибо
 
Может так тогда? Хотя это тоже не универсальное решение.
Код
Sub Selection2Column()
Dim c As Range, t As Range
  With Selection
    Set t = .Cells(1).Offset(, .Columns.Count)
    For Each c In .Columns
      c.Copy t
      Set t = Cells(Rows.Count, t.Column).End(xlUp).Offset(1)
    Next
  End With
End Sub
 
Без проверки, выделения диапазона:
Код
Sub Macro1()
Dim LastRow As Long, i As Long, j As Long, Rng As Range, FreeRow As Long, iCol As Long
    Set Rng = Selection
    iCol = Rng.Cells(1, Rng.Columns.Count).Column + 1
    FreeRow = 2
    For j = Rng.Cells(1, 1).Column To Rng.Cells(1, Rng.Columns.Count).Column
        LastRow = Columns(j).Cells(Rows.Count, 1).End(xlUp).Row
        Range(Cells(2, j), Cells(LastRow, j)).Copy Cells(FreeRow, iCol)
        FreeRow = Cells(Rows.Count, iCol).End(xlUp).Row + 1
    Next
End Sub
Страницы: 1
Наверх