Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 15.11.2017, 15:28   #1
Доктор
Пользователь
 
Регистрация: 06.05.2010
Сообщений: 73
По умолчанию Макрос для хитрого транспонирования данных

Добрый день, УВАЖАЕМЫЕ старожилы Форума!
Помогите плз решить проблему:
на листе Вход таблица (умная),
и на листе Маршрут то же таблица (умная).
В таблице на листе Вход данные представлены:
по вертикали - наименования изделий с дополнительными данными;
по горизонтали наименование оборудования, через которое проходит изделие.
На перекрестии слово ДА, это значит, что изделие проходит это оборудование.
Вопрос: как с помощью макроса привести таблицу на листе Вход к виду, указанному в таблице на листе маршрут.

С УВАЖЕНИЕМ,
Док
Вложения
Тип файла: xlsx Книга1.xlsx (17.7 Кб, 21 просмотров)
Доктор вне форума Ответить с цитированием
Старый 20.11.2017, 13:21   #2
ПаВлА
Пользователь
 
Регистрация: 20.11.2017
Сообщений: 16
По умолчанию

Может формулами обойтись?
Вложения
Тип файла: xlsx Книга1.xlsx (16.2 Кб, 16 просмотров)
ПаВлА вне форума Ответить с цитированием
Старый 21.11.2017, 11:59   #3
ПаВлА
Пользователь
 
Регистрация: 20.11.2017
Сообщений: 16
По умолчанию

Код:
Sub FindYES()
Dim i&, y&, z&, m&, rw&, kl&, kl2&, x As Range
Application.ScreenUpdating = False
With Application.WorksheetFunction
m = .Max(Columns("A:A"))
kl2 = .CountIf(Cells, "ДА")
ReDim t(1 To kl2, 1 To 11)
For i = 1 To m
    rw = Columns("A:A").Find(i, , xlValues, xlWhole).Row
    kl = .CountIf(Rows(rw), "ДА")
    Set x = Rows(rw).Find("ДА", , xlValues, xlWhole)
    For y = 1 To kl
        z = z + 1
        t(z, 1) = Cells(rw, 1)
        t(z, 2) = Cells(rw, 2)
        t(z, 3) = Cells(rw, 3)
        t(z, 4) = Cells(rw, 4)
        t(z, 5) = Cells(rw, 5)
        t(z, 6) = Cells(rw, 6)
        t(z, 7) = Cells(rw, 7)
        t(z, 8) = Cells(rw, 8)
        t(z, 9) = Cells(rw, 9)
        t(z, 10) = Cells(2, x.Column)
        t(z, 11) = "ДА"
        Set x = Rows(rw).FindNext(x)
    Next
Next
[A10:K10] = [{"№","СС","Наименование","Количество","Материал","Прокат","Толщина","Длина","Ширина","Участок","YES"}]
[A11].Resize(kl2, 11) = t
End With
Application.ScreenUpdating = True
End Sub
ПаВлА вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Макрос транспонирования Oleg778 Microsoft Office Excel 12 08.11.2016 23:51
Макрос для переноса (с удалением) данных с одного листа на другой при появлении дополнительных данных в ячейке - MS Excel Тохес Microsoft Office Excel 2 15.03.2016 22:26
Макрос для копирования данных из формы для формирования таблицы xander2112 Microsoft Office Excel 12 06.05.2013 22:23
Макрос для отбора данных dyakon88 Microsoft Office Excel 28 12.11.2010 15:56
Защита от хитрого сотрудника tolikman Свободное общение 11 23.10.2008 11:26