Операция по поиску и перемещению столбцов

[lioon]

Здравствуйте, столкнулся с проблемой по обработке информации в таблице.

Есть файл, который экспортируется из AutoCada в нём несколько десятков столбцов - это атрибуты.
Задача - зная определенные атрибуты расположить столбцы с их сначением на следующем листе в определенном порядке.
Что искать: (чтобы не загружать всем списком пусть будут первые 3 необходимых, остальные думаю искаться будут по аналогии): OPIS01, OPIS, DI.

Как я вижу алгоритм:
1 Найти значение OPIS01.
2 Выделить и скопировать данный столбец
3 вставить данный столбец на следующий лист последним столбцом
4 Найти значение OPIS ...
...
5 Найти значение DI ...
...

Попробовал сам, возникла сложность, не получается выделить и скопировать столбец с найденным значением и добавить на следующий лист последним столбцом

[Казанский]

Пробуйте

Const STLB = "OPIS01,OPIS, AAA, DI" 'через запятую, с пробелом или без

Sub lioon()
Dim x, c As Range, i&, w1 As Worksheet
Set w1 = ActiveSheet
With Worksheets.Add(after:=w1)
    For Each x In Split(STLB, ",")
        i = i + 1
        x = Trim(x)
        Set c = w1.Rows(1).Find(x, , xlValues, xlWhole)
        If c Is Nothing Then
            .Cells(1, i) = x: .Cells(2, i) = "нет!"
        Else
            c.EntireColumn.Copy .Cells(1, i)
        End If
    Next
End With
End Sub

[gluk_fm]

Или как вариант в приложении.

[lioon]

Спасибо огромное, всё работает великолепно, обработал все нужные файлы всего за несколько минут, в то время как с первым возился пару часов.

Для полной автоматизации процесса осталось решить ещё одну задачу:

В полученном файле столбец A это контур (E,F) и (I,J) и (M,N)-описание и канал.
Необходимо на новом листе получить таблицу, где в столбцы A,B,C записывались бы значения из соответствующих ячеек:

Вид 1 строки таблицы 1 во второй таблице
A B C
1 A E F
2 A I J
3 A M N

Вид 2 строки таблицы 1 во второй таблице
A B C
4 A E F
5 A I J
6 A M N

и т.д.

[Казанский]

Объясните подробнее. Это еще один новый лист? Дайте пример что есть - что надо получить.

[gluk_fm]

Если я правильно понял логику то Вам простоо необходимо произвести обьединение столбцов через знак & или просто прописать чтобы всталяло формулу и протягивало её до конца: =A1&B1&C1

[lioon]

Здравствуйте, в приложении пример исходной информации и как она должна обрабатываться.

[nilem]

Вот, например.

[lioon]

Спасибо! Работает для данного примера отлично.

Только в коде разобраться не смог :-(
В частности в:
i = UBound(x, 1) * UBound(x, 2) \ 3: ReDim y(1 To i, 1 To 3)
k = 1: y(k, 1) = x(1, 1): y(k, 2) = x(1, 2): y(k, 3) = x(1, 3)
и
k = k + 1: y(k, 1) = s: y(k, 2) = x(i, j): y(k, 3) = x(i, j + 1)
не сложно пояснить?

В результате возникли следующие вопросы:

1 как происходит выбор столбцов, с которых забираем Описание и Характеристику
2 как измениться код, если добавить ещё 2 столбца с описанием и характеристикой в исходную таблицу.
3 как измениться код, если описание и характеристика окажется не рядом, а через столбец.

[nilem]

i = UBound(x, 1) * UBound(x, 2) \ 3: ReDim y(1 To i, 1 To 3) - определяем размер выходного массива
k = 1: y(k, 1) = x(1, 1): y(k, 2) = x(1, 2): y(k, 3) = x(1, 3) - 1-я строка (шапка) итоговой таблицы
k = k + 1: y(k, 1) = s: y(k, 2) = x(i, j): y(k, 3) = x(i, j + 1) - заполняем выходной массив

1 как происходит выбор столбцов, с которых забираем Описание и Характеристику
For j = 2 To UBound(x, 2) Step 3 - начиная со 2-го столбца исходной таблицы с шагом 3 столбца, вправо до конца
2 как изменится код, если добавить ещё 2 столбца с описанием и характеристикой в исходную таблицу.
если 2, то все надо будет менять. Добавляйте по 3 столбца, чтобы шаг остался неизменным
3 как изменится код, если описание и характеристика окажутся не рядом, а через столбец.
т.е. будет: Описание, Сигнал, Характеристика - k = k + 1: y(k, 1) = s: y(k, 2) = x(i, j): y(k, 3) = x(i, j + 2)